1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21-module(httpc_response).
22
23-include_lib("inets/src/http_lib/http_internal.hrl").
24-include("httpc_internal.hrl").
25
26%% API
27%% Avoid warning for local function error/2 clashing with autoimported BIF.
28-compile({no_auto_import,[error/2]}).
29-export([parse/1, result/2, send/2, error/2, is_server_closing/1,
30	 stream_start/3]).
31
32%% Callback API - used for example if the header/body is received a
33%% little at a time on a socket.
34-export([parse_version/1, parse_status_code/1, parse_reason_phrase/1,
35	 parse_headers/1, whole_body/1, whole_body/2]).
36
37%%%=========================================================================
38%%%  API
39%%%=========================================================================
40
41parse([Bin, MaxHeaderSize, Relaxed]) ->
42    parse_version(Bin, [], MaxHeaderSize, [], Relaxed).
43
44whole_body([Bin, Body, Length])  ->
45    whole_body(<<Body/binary, Bin/binary>>, Length).
46
47%% Functions that may be returned during the decoding process
48%% if the input data is incompleate.
49parse_version([Bin, Version, MaxHeaderSize, Result, Relaxed]) ->
50    parse_version(Bin, Version, MaxHeaderSize, Result, Relaxed).
51
52parse_status_code([Bin, Code, MaxHeaderSize, Result, Relaxed]) ->
53    parse_status_code(Bin, Code, MaxHeaderSize, Result, Relaxed).
54
55parse_reason_phrase([Bin, Rest, Phrase, MaxHeaderSize, Result, Relaxed]) ->
56    parse_reason_phrase(<<Rest/binary, Bin/binary>>, Phrase,
57			MaxHeaderSize, Result, Relaxed).
58
59parse_headers([Bin, Rest,Header, Headers, MaxHeaderSize, Result, Relaxed]) ->
60    parse_headers(<<Rest/binary, Bin/binary>>, Header, Headers,
61		  MaxHeaderSize, Result, Relaxed).
62
63whole_body(Body, Length) ->
64    case size(Body) of
65	N when (N < Length) andalso (N > 0)  ->
66	    {?MODULE, whole_body, [Body, Length]};
67	%% OBS!  The Server may close the connection to indicate that the
68	%% whole body is now sent instead of sending a lengh
69	%% indicator.In this case the lengh indicator will be
70	%% -1.
71	N when (N >= Length) andalso (Length >= 0) ->
72	    %% Potential trailing garbage will be thrown away in
73	    %% format_response/1 Some servers may send a 100-continue
74	    %% response without the client requesting it through an
75	    %% expect header in this case the trailing bytes may be
76	    %% part of the real response message.
77	    {ok, Body};
78	_ -> %% Length == -1
79	    {?MODULE, whole_body, [Body, Length]}
80    end.
81
82%%-------------------------------------------------------------------------
83%% result(Response, Request) ->
84%%   Response - {StatusLine, Headers, Body}
85%%   Request - #request{}
86%%
87%% Description: Checks the status code ...
88%%-------------------------------------------------------------------------
89result(Response = {{_, Code,_}, _, _},
90       Request = #request{stream = Stream})
91  when ((Code =:= 200) orelse (Code =:= 206)) andalso (Stream =/= none) ->
92    stream_end(Response, Request);
93
94%% Ignore the body of response with status code 204 or 304
95result({{_, Code, _} = StatusLine, Headers, _Body}, Request)
96  when Code =:= 204 orelse Code =:= 304 ->
97    transparent({StatusLine, Headers, <<>>}, Request);
98
99result(Response = {{_, Code, _}, _, _}, Request)
100  when (100 =< Code andalso Code =< 199) ->
101    status_continue(Response, Request);
102
103%% In redirect loop
104result(Response = {{_, Code, _}, _, _}, Request =
105       #request{redircount = Redirects,
106		settings = #http_options{autoredirect = true}})
107  when ((Code div 100) =:= 3) andalso (Redirects > ?HTTP_MAX_REDIRECTS) ->
108    transparent(Response, Request);
109
110%% multiple choices
111result(Response = {{_, 300, _}, _, _},
112       Request = #request{settings =
113			  #http_options{autoredirect =
114					true}}) ->
115    redirect(Response, Request);
116
117result(Response = {{_, Code, _}, _, _},
118       Request = #request{settings =
119              #http_options{autoredirect = true},
120              method = post}) when (Code =:= 301) orelse
121                           (Code =:= 302) orelse
122                           (Code =:= 303) ->
123    redirect(Response, Request#request{method = get});
124result(Response = {{_, Code, _}, _, _},
125       Request = #request{settings =
126              #http_options{autoredirect = true},
127              method = post}) when (Code =:= 307) ->
128    redirect(Response, Request);
129result(Response = {{_, Code, _}, _, _},
130       Request = #request{settings =
131			  #http_options{autoredirect = true},
132			  method = Method}) when (Code =:= 301) orelse
133					       (Code =:= 302) orelse
134					       (Code =:= 303) orelse
135					       (Code =:= 307) ->
136    case lists:member(Method, [get, head, options, trace]) of
137    true ->
138        redirect(Response, Request);
139    false ->
140        transparent(Response, Request)
141    end;
142
143result(Response = {{_,503,_}, _, _}, Request) ->
144    status_service_unavailable(Response, Request);
145result(Response = {{_,Code,_}, _, _}, Request) when (Code div 100) =:= 5 ->
146    status_server_error_50x(Response, Request);
147
148result(Response, Request) ->
149    transparent(Response, Request).
150
151send(Receiver, Msg) when is_pid(Receiver) ->
152    Receiver ! {http, Msg};
153send(Receiver, Msg) when is_function(Receiver) ->
154    (catch Receiver(Msg));
155send({Module, Function, Args}, Msg) ->
156    (catch apply(Module, Function, [Msg | Args])).
157
158
159%%%========================================================================
160%%% Internal functions
161%%%========================================================================
162parse_version(<<>>, Version, MaxHeaderSize, Result, Relaxed) ->
163    {?MODULE, parse_version, [Version, MaxHeaderSize,Result, Relaxed]};
164parse_version(<<?SP, Rest/binary>>, Version,
165	      MaxHeaderSize, Result, Relaxed) ->
166    case lists:reverse(Version) of
167	"HTTP/" ++ _ = Newversion ->
168	    parse_status_code(Rest, [], MaxHeaderSize,
169			      [Newversion | Result], Relaxed);
170	NewVersion ->
171	    throw({error, {invalid_version, NewVersion}})
172    end;
173
174parse_version(<<Octet, Rest/binary>>, Version,
175	      MaxHeaderSize, Result, Relaxed) ->
176    parse_version(Rest, [Octet | Version], MaxHeaderSize,Result, Relaxed).
177
178parse_status_code(<<>>, StatusCodeStr, MaxHeaderSize, Result, Relaxed) ->
179    {?MODULE, parse_status_code,
180     [StatusCodeStr, MaxHeaderSize, Result, Relaxed]};
181
182%% Some Apache servers has been known to leave out the reason phrase,
183%% in relaxed mode we will allow this.
184parse_status_code(<<?CR>> = Data, StatusCodeStr,
185		  MaxHeaderSize, Result, true) ->
186    {?MODULE, parse_status_code,
187     [Data, StatusCodeStr, MaxHeaderSize, Result, true]};
188parse_status_code(<<?LF>>, StatusCodeStr,
189		  MaxHeaderSize, Result, true) ->
190    %% If ?CR is is missing RFC2616 section-19.3
191    parse_status_code(<<?CR, ?LF>>, StatusCodeStr,
192		      MaxHeaderSize, Result, true);
193
194parse_status_code(<<?CR, ?LF, Rest/binary>>, StatusCodeStr,
195		  MaxHeaderSize, Result, true) ->
196    parse_headers(Rest, [], [], MaxHeaderSize,
197 		  [" ", list_to_integer(lists:reverse(
198                                          string:trim(StatusCodeStr)))
199		   | Result], true);
200
201parse_status_code(<<?SP, Rest/binary>>, StatusCodeStr,
202		  MaxHeaderSize, Result, Relaxed) ->
203    parse_reason_phrase(Rest, [], MaxHeaderSize,
204			[list_to_integer(lists:reverse(StatusCodeStr)) |
205			 Result], Relaxed);
206
207parse_status_code(<<Octet, Rest/binary>>, StatusCodeStr,
208		  MaxHeaderSize,Result, Relaxed) ->
209    parse_status_code(Rest, [Octet | StatusCodeStr], MaxHeaderSize, Result,
210		      Relaxed).
211
212parse_reason_phrase(<<>>, Phrase, MaxHeaderSize, Result, Relaxed) ->
213    {?MODULE, parse_reason_phrase,
214     [<<>>, Phrase, MaxHeaderSize, Result, Relaxed]};
215
216parse_reason_phrase(<<?CR, ?LF, ?LF, Body/binary>>, Phrase,
217  		    MaxHeaderSize, Result, Relaxed) ->
218    %% If ?CR is is missing RFC2616 section-19.3
219    parse_reason_phrase(<<?CR, ?LF, ?CR, ?LF, Body/binary>>, Phrase,
220			MaxHeaderSize, Result, Relaxed);
221
222parse_reason_phrase(<<?CR, ?LF, ?CR, ?LF, Body/binary>>, Phrase,
223  		    _, Result, _) ->
224    ResponseHeaderRcord =
225   	http_response:headers([], #http_response_h{}),
226     {ok, list_to_tuple(
227	    lists:reverse([Body, ResponseHeaderRcord |
228			   [lists:reverse(Phrase) | Result]]))};
229
230parse_reason_phrase(<<?CR, ?LF, ?CR>> = Data, Phrase, MaxHeaderSize, Result,
231		    Relaxed) ->
232    {?MODULE, parse_reason_phrase, [Data, Phrase, MaxHeaderSize, Result],
233     Relaxed};
234
235parse_reason_phrase(<<?CR, ?LF>> = Data, Phrase, MaxHeaderSize, Result,
236		    Relaxed) ->
237    {?MODULE, parse_reason_phrase, [Data, Phrase, MaxHeaderSize, Result,
238				    Relaxed]};
239parse_reason_phrase(<<?LF, Rest/binary>>, Phrase,
240 		    MaxHeaderSize, Result, Relaxed) ->
241    %% If ?CR is is missing RFC2616 section-19.3
242    parse_reason_phrase(<<?CR, ?LF, Rest/binary>>, Phrase,
243			MaxHeaderSize, Result, Relaxed);
244parse_reason_phrase(<<?CR, ?LF, Rest/binary>>, Phrase,
245 		    MaxHeaderSize, Result, Relaxed) ->
246    parse_headers(Rest, [], [], MaxHeaderSize,
247 		  [lists:reverse(Phrase) | Result], Relaxed);
248parse_reason_phrase(<<?LF>>, Phrase, MaxHeaderSize, Result, Relaxed) ->
249    %% If ?CR is is missing RFC2616 section-19.3
250    parse_reason_phrase(<<?CR, ?LF>>, Phrase, MaxHeaderSize, Result,
251			Relaxed);
252parse_reason_phrase(<<?CR>> = Data, Phrase, MaxHeaderSize, Result, Relaxed) ->
253    {?MODULE, parse_reason_phrase,
254     [Data, Phrase, MaxHeaderSize, Result, Relaxed]};
255parse_reason_phrase(<<Octet, Rest/binary>>, Phrase, MaxHeaderSize, Result,
256		    Relaxed) ->
257    parse_reason_phrase(Rest, [Octet | Phrase], MaxHeaderSize,
258			Result, Relaxed).
259
260parse_headers(<<>>, Header, Headers, MaxHeaderSize, Result, Relaxed) ->
261    {?MODULE, parse_headers, [<<>>, Header, Headers, MaxHeaderSize, Result,
262			      Relaxed]};
263
264parse_headers(<<?CR,?LF,?LF,Body/binary>>, Header, Headers,
265	      MaxHeaderSize, Result, Relaxed) ->
266    %% If ?CR is is missing RFC2616 section-19.3
267    parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers,
268		  MaxHeaderSize, Result, Relaxed);
269
270parse_headers(<<?LF,?LF,Body/binary>>, Header, Headers,
271	      MaxHeaderSize, Result, Relaxed) ->
272    %% If ?CR is is missing RFC2616 section-19.3
273    parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers,
274		  MaxHeaderSize, Result, Relaxed);
275
276parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers,
277	      MaxHeaderSize, Result, Relaxed) ->
278    HTTPHeaders = [lists:reverse(Header) | Headers],
279    Length = lists:foldl(fun(H, Acc) -> length(H) + Acc end,
280			   0, HTTPHeaders),
281    case ((Length =< MaxHeaderSize) or (MaxHeaderSize == nolimit)) of
282 	true ->
283	    ResponseHeaderRcord =
284		http_response:headers(HTTPHeaders, #http_response_h{}),
285
286            %% RFC7230, Section 3.3.3
287            %% If a message is received with both a Transfer-Encoding and a
288            %% Content-Length header field, the Transfer-Encoding overrides the
289            %% Content-Length. Such a message might indicate an attempt to
290            %% perform request smuggling (Section 9.5) or response splitting
291            %% (Section 9.4) and ought to be handled as an error. A sender MUST
292            %% remove the received Content-Length field prior to forwarding such
293            %% a message downstream.
294            case ResponseHeaderRcord#http_response_h.'transfer-encoding' of
295                undefined ->
296                    {ok, list_to_tuple(
297                           lists:reverse([Body, ResponseHeaderRcord | Result]))};
298                Value ->
299                    TransferEncoding = string:lowercase(Value),
300                    ContentLength = ResponseHeaderRcord#http_response_h.'content-length',
301                    if
302                        %% Respond without error but remove Content-Length field in relaxed mode
303                        (Relaxed =:= true)
304                        andalso (TransferEncoding =:= "chunked")
305                        andalso (ContentLength =/= "-1") ->
306                            ResponseHeaderRcordFixed =
307                                ResponseHeaderRcord#http_response_h{'content-length' = "-1"},
308                            {ok, list_to_tuple(
309                                   lists:reverse([Body, ResponseHeaderRcordFixed | Result]))};
310                        %% Respond with error in default (not relaxed) mode
311                        (Relaxed =:= false)
312                        andalso (TransferEncoding =:= "chunked")
313                        andalso (ContentLength =/= "-1") ->
314                            throw({error, {headers_conflict, {'content-length',
315                                                              'transfer-encoding'}}});
316                        true  ->
317                            {ok, list_to_tuple(
318                                   lists:reverse([Body, ResponseHeaderRcord | Result]))}
319                    end
320            end;
321 	false ->
322	    throw({error, {header_too_long, MaxHeaderSize,
323			   MaxHeaderSize-Length}})
324    end;
325parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers,
326	      MaxHeaderSize, Result, Relaxed) ->
327    {?MODULE, parse_headers, [Data, Header, Headers,
328			      MaxHeaderSize, Result, Relaxed]};
329parse_headers(<<?CR,?LF>> = Data, Header, Headers,
330	      MaxHeaderSize, Result, Relaxed) ->
331    {?MODULE, parse_headers, [Data, Header, Headers, MaxHeaderSize,
332			      Result, Relaxed]};
333parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers,
334	      MaxHeaderSize, Result, Relaxed) ->
335    parse_headers(Rest, [Octet],
336		  [lists:reverse(Header) | Headers], MaxHeaderSize,
337		  Result, Relaxed);
338parse_headers(<<?CR>> = Data, Header, Headers,
339	      MaxHeaderSize, Result, Relaxed) ->
340    {?MODULE, parse_headers, [Data, Header, Headers, MaxHeaderSize,
341			      Result, Relaxed]};
342
343parse_headers(<<?LF>>, Header, Headers,
344	      MaxHeaderSize, Result, Relaxed) ->
345    %% If ?CR is is missing RFC2616 section-19.3
346    parse_headers(<<?CR, ?LF>>, Header, Headers,
347		  MaxHeaderSize, Result, Relaxed);
348
349parse_headers(<<Octet, Rest/binary>>, Header, Headers,
350	      MaxHeaderSize, Result, Relaxed) ->
351    parse_headers(Rest, [Octet | Header], Headers, MaxHeaderSize,
352		  Result, Relaxed).
353
354
355%% RFC2616, Section 10.1.1
356%% Note:
357%% - Only act on the 100 status if the request included the
358%%   "Expect:100-continue" header, otherwise just ignore this response.
359status_continue(_, #request{headers =
360			    #http_request_h{expect = "100-continue"}}) ->
361    continue;
362
363status_continue({_,_, Data}, _) ->
364    %% The data in the body in this case is actually part of the real
365    %% response.
366    {ignore, Data}.
367
368status_service_unavailable(Response = {_, Headers, _}, Request) ->
369    case Headers#http_response_h.'retry-after' of
370	undefined ->
371	    status_server_error_50x(Response, Request);
372	Time when (length(Time) < 3) -> % Wait only 99 s or less
373	    NewTime = list_to_integer(Time) * 1000, % time in ms
374	    {_, Data} =  format_response(Response),
375	    {retry, {NewTime, Request}, Data};
376	_ ->
377	    status_server_error_50x(Response, Request)
378    end.
379
380status_server_error_50x(Response, Request) ->
381    {Msg, _} =  format_response(Response),
382    {stop, {Request#request.id, Msg}}.
383
384
385redirect(Response = {_, Headers, _}, Request) ->
386    {_, Data} =  format_response(Response),
387    case Headers#http_response_h.location of
388        undefined ->
389            transparent(Response, Request);
390        RedirUrl ->
391            Brackets = Request#request.ipv6_host_with_brackets,
392            case uri_string:parse(RedirUrl) of
393                {error, Reason, _} ->
394                    {ok, error(Request, Reason), Data};
395                %% Automatic redirection
396                URI ->
397                    {Host, Port0} = Request#request.address,
398                    Port = maybe_to_integer(Port0),
399                    Path = Request#request.path,
400                    Scheme = atom_to_list(Request#request.scheme),
401                    Query = Request#request.pquery,
402                    URIMap = resolve_uri(Scheme, Host, Port, Path, Query, URI),
403                    TScheme = list_to_atom(maps:get(scheme, URIMap)),
404                    THost = http_util:maybe_add_brackets(maps:get(host, URIMap), Brackets),
405                    TPort = maps:get(port, URIMap),
406                    TPath = maps:get(path, URIMap),
407                    TQuery = add_question_mark(maps:get(query, URIMap, "")),
408                    NewURI = uri_string:normalize(
409                               uri_string:recompose(URIMap)),
410                    HostPort = http_request:normalize_host(TScheme, THost, TPort),
411                    NewHeaders =
412                        (Request#request.headers)#http_request_h{host = HostPort},
413                    NewRequest =
414                        Request#request{redircount =
415                                            Request#request.redircount+1,
416                                        scheme = TScheme,
417                                        headers = NewHeaders,
418                                        address = {THost,TPort},
419                                        path = TPath,
420                                        pquery = TQuery,
421                                        abs_uri = NewURI},
422                    {redirect, NewRequest, Data}
423            end
424    end.
425
426add_question_mark(<<>>) ->
427    <<>>;
428add_question_mark([]) ->
429    [];
430add_question_mark(Comp) when is_binary(Comp) ->
431    <<$?, Comp/binary>>;
432add_question_mark(Comp) when is_list(Comp) ->
433    [$?|Comp].
434
435%% RFC3986 - 5.2.2.  Transform References
436resolve_uri(Scheme, Host, Port, Path, Query, URI) ->
437    resolve_uri(Scheme, Host, Port, Path, Query, URI, #{}).
438%%
439resolve_uri(Scheme, Host, Port, Path, Query, URI, Map0) ->
440    case maps:get(scheme, URI, undefined) of
441        undefined ->
442            Port0 = get_port(Scheme, URI),
443            Map = Map0#{scheme => Scheme,
444                        port => Port0},
445            resolve_authority(Host, Port, Path, Query, URI, Map);
446        URIScheme ->
447            Port0 = get_port(URIScheme, URI),
448            maybe_add_query(
449              Map0#{scheme => URIScheme,
450                    host => maps:get(host, URI),
451                    port => Port0,
452                    path => maps:get(path, URI)},
453              URI)
454    end.
455
456
457get_port(Scheme, URI) ->
458    case maps:get(port, URI, undefined) of
459        undefined ->
460            get_default_port(Scheme);
461        Port ->
462            Port
463    end.
464
465
466get_default_port("http") ->
467    80;
468get_default_port("https") ->
469    443.
470
471
472resolve_authority(Host, Port, Path, Query, RelURI, Map) ->
473    case maps:is_key(host, RelURI) of
474        true ->
475            maybe_add_query(
476              Map#{host => maps:get(host, RelURI),
477                   path => maps:get(path, RelURI)},
478              RelURI);
479        false ->
480            Map1 = Map#{host => Host,
481                        port => Port},
482            resolve_path(Path, Query, RelURI, Map1)
483    end.
484
485
486maybe_add_query(Map, RelURI) ->
487     case maps:is_key(query, RelURI) of
488         true ->
489             Map#{query => maps:get(query, RelURI)};
490         false ->
491             Map
492         end.
493
494
495resolve_path(Path, Query, RelURI, Map) ->
496    case maps:is_key(path, RelURI) of
497        true ->
498            Path1 = calculate_path(Path,  maps:get(path, RelURI)),
499            maybe_add_query(
500              Map#{path => Path1},
501              RelURI);
502        false ->
503            Map1 = Map#{path => Path},
504            resolve_query(Query, RelURI, Map1)
505    end.
506
507
508calculate_path(BaseP, RelP) ->
509    case starts_with_slash(RelP) of
510        true ->
511            RelP;
512        false ->
513            merge_paths(BaseP, RelP)
514    end.
515
516
517starts_with_slash([$/|_]) ->
518    true;
519starts_with_slash(<<$/,_/binary>>) ->
520    true;
521starts_with_slash(_) ->
522    false.
523
524
525%% RFC3986 - 5.2.3.  Merge Paths
526merge_paths("", RelP) ->
527    [$/|RelP];
528merge_paths(BaseP, RelP) when is_list(BaseP) ->
529    do_merge_paths(lists:reverse(BaseP), RelP);
530merge_paths(BaseP, RelP) when is_binary(BaseP) ->
531    B = binary_to_list(BaseP),
532    R = binary_to_list(RelP),
533    Res = merge_paths(B, R),
534    list_to_binary(Res).
535
536
537do_merge_paths([$/|_] = L, RelP) ->
538    lists:reverse(L) ++ RelP;
539do_merge_paths([_|T], RelP) ->
540    do_merge_paths(T, RelP).
541
542
543resolve_query(Query, RelURI, Map) ->
544    case maps:is_key(query, RelURI) of
545        true ->
546            Map#{query => maps:get(query, RelURI)};
547        false ->
548            Map#{query => Query}
549    end.
550
551
552maybe_to_integer(Port) when is_list(Port) ->
553    {Port1, _} = string:to_integer(Port),
554    Port1;
555maybe_to_integer(Port) when is_integer(Port) ->
556    Port.
557
558
559error(#request{id = Id}, Reason) ->
560    {Id, {error, Reason}}.
561
562transparent(Response, Request) ->
563    {Msg, Data} =  format_response(Response),
564    {ok, {Request#request.id, Msg}, Data}.
565
566stream_start(Headers, Request, ignore) ->
567    {Request#request.id, stream_start, http_response:header_list(Headers)};
568
569stream_start(Headers, Request, Pid) ->
570    {Request#request.id, stream_start,
571     http_response:header_list(Headers), Pid}.
572
573stream_end(Response, Request = #request{stream = Self})
574  when (Self =:= self) orelse (Self =:= {self, once}) ->
575    {{_, Headers, _}, Data} =  format_response(Response),
576    {ok, {Request#request.id, stream_end, Headers}, Data};
577
578stream_end(Response, Request) ->
579    {_, Data} =  format_response(Response),
580    {ok, {Request#request.id, saved_to_file}, Data}.
581
582is_server_closing(Headers) when is_record(Headers, http_response_h) ->
583    case Headers#http_response_h.connection of
584	"close" ->
585	    true;
586	_ ->
587	    false
588    end.
589
590format_response({StatusLine, Headers, Body = <<>>}) ->
591    {{StatusLine, http_response:header_list(Headers), Body}, <<>>};
592
593format_response({StatusLine, Headers, Body}) ->
594    Length = list_to_integer(Headers#http_response_h.'content-length'),
595    {NewBody, Data} =
596	case Length of
597	    -1 -> % When no length indicator is provided
598		{Body, <<>>};
599	    Length when (Length =< size(Body)) ->
600		<<BodyThisReq:Length/binary, Next/binary>> = Body,
601		{BodyThisReq, Next};
602	    _ -> %% Connection prematurely ended.
603		{Body, <<>>}
604	end,
605    {{StatusLine, http_response:header_list(Headers), NewBody}, Data}.
606