1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2001-2016. 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(httpd_test_lib).
22
23-include("inets_test_lib.hrl").
24
25%% Poll functions
26-export([verify_request/6, verify_request/7, verify_request/8, is_expect/1,
27	 verify_request_N/9]).
28
29-record(state, {request,        % string()
30		socket,         % socket()
31		status_line,    % {Version, StatusCode, ReasonPharse}
32		headers,        % #http_response_h{}
33		body,           % binary()
34		mfa = {httpc_response, parse, [nolimit, false]},
35		canceled = [],	       % [RequestId]
36		max_header_size = nolimit,   % nolimit | integer()
37		max_body_size = nolimit,    % nolimit | integer()
38		print = false
39	       }).
40
41%%% Part of http.hrl - Temporary solution %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
42%%% Response headers
43-record(http_response_h,{
44%%% --- Standard "General" headers
45 	  'cache-control',
46 	  connection,
47 	  date,
48 	  pragma,
49 	  trailer,
50 	  'transfer-encoding',
51 	  upgrade,
52 	  via,
53 	  warning,
54%%% --- Standard "Response" headers
55 	  'accept-ranges',
56 	  age,
57 	  etag,
58 	  location,
59 	  'proxy-authenticate',
60 	  'retry-after',
61 	  server,
62 	  vary,
63 	  'www-authenticate',
64%%% --- Standard "Entity" headers
65 	  allow,
66 	  'content-encoding',
67 	  'content-language',
68 	  'content-length' = "0",
69 	  'content-location',
70	  'content-md5',
71 	  'content-range',
72 	  'content-type',
73 	  expires,
74 	  'last-modified',
75	  other=[]        % list() - Key/Value list with other headers
76	 }).
77
78
79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80
81%%--------------------------------------------------------------------
82%% API
83%%------------------------------------------------------------------
84
85verify_request(SocketType, Host, Port, Node, RequestStr, Options) ->
86    verify_request(SocketType, Host, Port, Node, RequestStr, Options, 30000).
87
88verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options)
89  when is_list(TranspOpts) ->
90    verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, 30000);
91
92verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut)
93  when (is_integer(TimeOut) orelse (TimeOut =:= infinity)) ->
94    verify_request(SocketType, Host, Port, [], Node, RequestStr, Options, TimeOut).
95
96verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, TimeOut) ->
97    try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of
98	{ok, Socket} ->
99	    ok = inets_test_lib:send(SocketType, Socket, RequestStr),
100	    State = case re:run(RequestStr, "printenv", [{capture, none}]) of
101			nomatch ->
102			    #state{};
103			match ->
104			    #state{print = true}
105		    end,
106
107	    case request(State#state{request = RequestStr,
108				     socket  = Socket}, TimeOut) of
109		{error, Reason} ->
110		    {error, Reason};
111		NewState ->
112		    ValidateResult =
113		   	validate(RequestStr, NewState, Options, Node, Port),
114		    inets_test_lib:close(SocketType, Socket),
115		    ValidateResult
116	    end;
117
118	ConnectError ->
119	    ct:fail({connect_error, ConnectError,
120		     [SocketType, Host, Port, TranspOpts]})
121    catch
122	T:E:Stk ->
123	    ct:fail({connect_failure,
124		     [{type,       T},
125		      {error,      E},
126		      {stacktrace, Stk},
127		      {args,       [SocketType, Host, Port, TranspOpts]}]})
128    end.
129
130verify_request_N(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, TimeOut, N) ->
131    State = #state{},
132     try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of
133	{ok, Socket} ->
134	     request_N(SocketType, Socket, RequestStr, Options, TimeOut, Node, Port, State, N);
135	ConnectError ->
136	    ct:fail({connect_error, ConnectError,
137		     [SocketType, Host, Port, TranspOpts]})
138    catch
139	T:E:Stk ->
140	    ct:fail({connect_failure,
141		     [{type,       T},
142		      {error,      E},
143		      {stacktrace, Stk},
144		      {args,       [SocketType, Host, Port, TranspOpts]}]})
145    end.
146
147request_N(SocketType, Socket, RequestStr, Options, TimeOut, Node, Port, State, 0) ->
148    ok = inets_test_lib:send(SocketType, Socket, RequestStr),
149    case request(State#state{request = RequestStr,
150			     socket  = Socket}, TimeOut) of
151	{error, Reason} ->
152	    {error, Reason};
153	NewState ->
154	    ValidateResult =
155		validate(RequestStr, NewState, Options, Node, Port),
156	    inets_test_lib:close(SocketType, Socket),
157	    ValidateResult
158    end;
159request_N(SocketType, Socket, RequestStr, Options, TimeOut, Node, Port, State, N) ->
160    ok = inets_test_lib:send(SocketType, Socket, RequestStr),
161    case request(State#state{request = RequestStr,
162			     socket  = Socket}, TimeOut) of
163	{error, Reason} ->
164	    {error, Reason};
165	_NewState ->
166	    request_N(SocketType, Socket, RequestStr, Options, TimeOut, Node, Port,
167		      #state{}, N-1)
168    end.
169
170request(#state{mfa = {Module, Function, Args},
171	       request = RequestStr, socket = Socket} = State, TimeOut) ->
172
173    HeadRequest = lists:sublist(RequestStr, 1, 4),
174    receive
175	{tcp, Socket, Data} ->
176	    case Module:Function([Data | Args]) of
177		{ok, Parsed} ->
178		    handle_http_msg(Parsed, State);
179		{_, whole_body, _} when HeadRequest =:= "HEAD" ->
180		    State#state{body = <<>>};
181		NewMFA ->
182		    request(State#state{mfa = NewMFA}, TimeOut)
183	    end;
184	{tcp_closed, Socket} when Function =:= whole_body ->
185	    State#state{body = hd(Args)};
186	{tcp_closed, Socket} ->
187	    exit({test_failed, connection_closed});
188	{tcp_error, Socket, Reason} ->
189	    ct:fail({tcp_error, Reason});
190	{ssl, Socket, Data} ->
191	    case Module:Function([Data | Args]) of
192		{ok, Parsed} ->
193		    handle_http_msg(Parsed, State);
194		{_, whole_body, _} when HeadRequest =:= "HEAD" ->
195		    State#state{body = <<>>};
196		NewMFA ->
197		    request(State#state{mfa = NewMFA}, TimeOut)
198	    end;
199	{ssl_closed, Socket}  when Function =:= whole_body ->
200	    State#state{body = hd(Args)};
201	{ssl_closed, Socket} ->
202	    exit({test_failed, connection_closed});
203	{ssl_error, Socket, Reason} ->
204	    ct:fail({ssl_error, Reason});
205	{Socket, {data, Data}} when is_port(Socket) ->
206	    case Module:Function([list_to_binary(Data) | Args]) of
207		{ok, Parsed} ->
208		    port_handle_http_msg(Parsed, State);
209		{_, whole_body, _} when HeadRequest =:= "HEAD" ->
210		    State#state{body = <<>>};
211		NewMFA ->
212		    request(State#state{mfa = NewMFA}, TimeOut)
213	    end;
214	{Socket, closed}  when Function =:= whole_body ->
215	    State#state{body = hd(Args)};
216	{Socket, closed} ->
217	    exit({test_failed, connection_closed})
218    after TimeOut ->
219	    ct:pal("~p ~w[~w]request -> timeout"
220		   "~p~n", [self(), ?MODULE, ?LINE, Args]),
221	    ct:fail(connection_timed_out)
222    end.
223
224
225port_handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, State) ->
226    State#state{status_line = {Version,
227			       StatusCode,
228			       ReasonPharse},
229		headers = Headers,
230		body = Body}.
231
232
233handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body},
234		State = #state{request = RequestStr}) ->
235    case is_expect(RequestStr) of
236	true ->
237	    State#state{status_line = {Version,
238				       StatusCode,
239				       ReasonPharse},
240			headers = Headers};
241	false ->
242	    handle_http_body(Body,
243			     State#state{status_line = {Version,
244							StatusCode,
245							ReasonPharse},
246					 headers = Headers})
247    end;
248
249handle_http_msg({ChunkedHeaders, Body},
250		State = #state{headers = Headers}) ->
251    NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders),
252    State#state{headers = NewHeaders, body = Body};
253
254handle_http_msg(Body, State) ->
255    State#state{body = Body}.
256
257handle_http_body(<<>>, State = #state{request = "HEAD" ++ _}) ->
258    State#state{body = <<>>};
259
260handle_http_body(Body, State = #state{headers = Headers,
261				      max_body_size = MaxBodySize}) ->
262     case Headers#http_response_h.'transfer-encoding' of
263        "chunked" ->
264	    case http_chunk:decode(Body, State#state.max_body_size,
265				   State#state.max_header_size) of
266		{Module, Function, Args} ->
267		   request(State#state{mfa = {Module, Function, Args}},
268			   30000);
269		{ok, {ChunkedHeaders, NewBody}} ->
270		    NewHeaders = http_chunk:handle_headers(Headers,
271							   ChunkedHeaders),
272		    State#state{headers = NewHeaders, body = NewBody}
273	    end;
274	 _ ->
275	     Length =
276		 list_to_integer(Headers#http_response_h.'content-length'),
277	     case ((Length =< MaxBodySize) or (MaxBodySize == nolimit)) of
278		 true ->
279		     case httpc_response:whole_body(Body, Length) of
280			 {ok, NewBody} ->
281			     State#state{body = NewBody};
282			 MFA ->
283			     request(State#state{mfa = MFA}, 5000)
284		     end;
285		 false ->
286		     ct:fail(body_too_big)
287	     end
288     end.
289
290validate(RequestStr, #state{status_line = {Version, StatusCode, _},
291			    headers     = Headers,
292			    body        = Body}, Options, N, P) ->
293
294    check_version(Version, Options),
295    case lists:keysearch(statuscode, 1, Options) of
296	{value, _} ->
297	    check_status_code(StatusCode, Options, Options);
298	_ ->
299	    ok
300    end,
301    HList = http_response:header_list(Headers),
302    do_validate(HList, Options, N, P),
303    case lists:keysearch("warning", 1, HList) of
304	{value, _} ->
305	    ok;
306	_ ->
307	    check_body(RequestStr, StatusCode,
308		       Headers#http_response_h.'content-type',
309		       list_to_integer(Headers#http_response_h.'content-length'),
310		       Body)
311    end.
312
313%--------------------------------------------------------------------
314%% Internal functions
315%%------------------------------------------------------------------
316check_version(Version, Options) ->
317    case lists:keysearch(version, 1, Options) of
318	{value, {version, Version}} ->
319	    	   ok;
320	{value, {version, Ver}} ->
321	    ct:fail({wrong_version, [{got, Version},
322				     {expected, Ver}]});
323	_ ->
324	    case Version of
325		"HTTP/1.1" ->
326		    ok;
327	       _ ->
328		    ct:fail({wrong_version, [{got,      Version},
329					     {expected, "HTTP/1.1"}]})
330	    end
331    end.
332
333check_status_code(StatusCode, [], Options) ->
334    ct:fail({wrong_status_code, [{got, StatusCode}, {expected, Options}]});
335check_status_code(StatusCode, Current = [_ | Rest], Options) ->
336    case lists:keysearch(statuscode, 1, Current) of
337	{value, {statuscode, StatusCode}} ->
338	    ok;
339	{value, {statuscode, _OtherStatus}} ->
340	    check_status_code(StatusCode, Rest, Options);
341	false ->
342	    ct:fail({wrong_status_code, [{got, StatusCode}, {expected, Options}]})
343    end.
344
345do_validate(_, [], _, _) ->
346    ok;
347do_validate(Header, [{statuscode, _Code} | Rest], N, P) ->
348    do_validate(Header, Rest, N, P);
349do_validate(Header, [{header, HeaderField}|Rest], N, P) ->
350    LowerHeaderField = http_util:to_lower(HeaderField),
351    case lists:keysearch(LowerHeaderField, 1, Header) of
352	{value, {LowerHeaderField, _Value}} ->
353	    ok;
354	false ->
355	    ct:fail({missing_header_field, LowerHeaderField, Header});
356	_ ->
357	    ct:fail({missing_header_field, LowerHeaderField, Header})
358    end,
359    do_validate(Header, Rest, N, P);
360do_validate(Header, [{header, HeaderField, Value}|Rest],N,P) ->
361    LowerHeaderField = http_util:to_lower(HeaderField),
362    case lists:keysearch(LowerHeaderField, 1, Header) of
363	{value, {LowerHeaderField, Value}} ->
364	    ok;
365	false ->
366	    ct:fail({wrong_header_field_value, LowerHeaderField, Header, Value});
367	_ ->
368	    ct:fail({wrong_header_field_value, LowerHeaderField, Header, Value})
369    end,
370    do_validate(Header, Rest, N, P);
371do_validate(Header,[{no_header, HeaderField}|Rest],N,P) ->
372    case lists:keysearch(HeaderField,1,Header) of
373	{value,_} ->
374	    ct:fail({wrong_header_field_value, HeaderField, Header});
375	_ ->
376	    ok
377    end,
378    do_validate(Header, Rest, N, P);
379do_validate(Header, [_Unknown | Rest], N, P) ->
380    do_validate(Header, Rest, N, P).
381
382is_expect(RequestStr) ->
383    case re:run(RequestStr, "xpect:100-continue", [{capture, none}]) of
384	match->
385	    true;
386	nomatch ->
387	    false
388    end.
389
390%% OTP-5775, content-length
391check_body("GET /cgi-bin/erl/httpd_example:get_bin HTTP/1.1\r\n\r\n", 200, "text/html", Length, _Body) when (Length =/= 274) ->
392    ct:fail({content_length_error, Length});
393check_body("GET /cgi-bin/cgi_echo HTTP/1.0\r\n\r\n", 200, "text/plain",
394	   _, Body) ->
395    case size(Body) of
396	100 ->
397	    ok;
398	_ ->
399	    ct:fail(content_length_error)
400    end;
401
402check_body(RequestStr, 200, "text/html", _, Body) ->
403    HeadRequest = lists:sublist(RequestStr, 1, 3),
404    case HeadRequest of
405	"GET" ->
406	    inets_test_lib:check_body(binary_to_list(Body));
407	_ ->
408	    ok
409    end;
410
411check_body(_, _, _, _,_) ->
412    ok.
413
414