Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 161 lines (147 sloc) 6.329 kb
e56b4d3 @oscarh Add test cases.
oscarh authored
1 %%% ----------------------------------------------------------------------------
2 %%% Copyright (c) 2009, Erlang Training and Consulting Ltd.
3 %%% All rights reserved.
4 %%%
5 %%% Redistribution and use in source and binary forms, with or without
6 %%% modification, are permitted provided that the following conditions are met:
7 %%% * Redistributions of source code must retain the above copyright
8 %%% notice, this list of conditions and the following disclaimer.
9 %%% * Redistributions in binary form must reproduce the above copyright
10 %%% notice, this list of conditions and the following disclaimer in the
11 %%% documentation and/or other materials provided with the distribution.
12 %%% * Neither the name of Erlang Training and Consulting Ltd. nor the
13 %%% names of its contributors may be used to endorse or promote products
14 %%% derived from this software without specific prior written permission.
15 %%%
16 %%% THIS SOFTWARE IS PROVIDED BY Erlang Training and Consulting Ltd. ''AS IS''
17 %%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18 %%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19 %%% ARE DISCLAIMED. IN NO EVENT SHALL Erlang Training and Consulting Ltd. BE
20 %%% LIABLE SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
21 %%% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
22 %%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
23 %%% OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
24 %%% ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
25 %%% ----------------------------------------------------------------------------
26
4d22f71 @oscarh Erlang source files should be encoded as iso-8859-1. (Richard Carlsson
oscarh authored
27 %%% @author Oscar Hellström <oscar@hellstrom.st>
e56b4d3 @oscarh Add test cases.
oscarh authored
28 %%% @author Magnus Henoch <magnus@erlang-consulting.com>
29 %%% @doc Simple web server for testing purposes
30 %%% @end
31 -module(webserver).
32
4dc0002 @oscarh Fix error in merge.
oscarh authored
33 -export([start/2, read_chunked/3]).
4bac1a5 @oscarh Avoid sending exit messages from test webserver
oscarh authored
34 -export([accept_connection/4]).
e56b4d3 @oscarh Add test cases.
oscarh authored
35
36 start(Module, Responders) ->
5d86992 @oscarh Add / fix ssl tests
oscarh authored
37 LS = listen(Module),
4bac1a5 @oscarh Avoid sending exit messages from test webserver
oscarh authored
38 spawn_link(?MODULE, accept_connection, [self(), Module, LS, Responders]),
e56b4d3 @oscarh Add test cases.
oscarh authored
39 port(Module, LS).
40
4bac1a5 @oscarh Avoid sending exit messages from test webserver
oscarh authored
41 accept_connection(Parent, Module, ListenSocket, Responders) ->
e56b4d3 @oscarh Add test cases.
oscarh authored
42 Socket = accept(Module, ListenSocket),
4bac1a5 @oscarh Avoid sending exit messages from test webserver
oscarh authored
43 server_loop(Module, Socket, nil, [], Responders),
44 unlink(Parent).
e56b4d3 @oscarh Add test cases.
oscarh authored
45
4972189 @oscarh Adding test cases for partial upload.
oscarh authored
46 read_chunked(Module, Socket, Headers) ->
47 Body = read_chunks(Module, Socket, []),
48 ok = setopts(Module, Socket, [{packet, httph}]),
bd69f60 @oscarh Reset the packet format after reading chunks in test web server.
oscarh authored
49 Trailers = read_trailers(Module, Socket, Headers),
50 % For next request
51 ok = setopts(Module, Socket, [{packet, http}]),
52 {Body, Trailers}.
4972189 @oscarh Adding test cases for partial upload.
oscarh authored
53
54 read_chunks(Module, Socket, Acc) ->
55 ok = setopts(Module, Socket, [{packet, line}]),
56 case Module:recv(Socket, 0) of
57 {ok, HexSizeExtension} ->
58 case chunk_size(HexSizeExtension, []) of
59 0 ->
60 list_to_binary(lists:reverse(Acc));
c21117c @oscarh Fix indentation
oscarh authored
61 Size ->
4972189 @oscarh Adding test cases for partial upload.
oscarh authored
62 setopts(Module, Socket, [{packet, raw}]),
480be44 @oscarh Read chunks correctly in test web server.
oscarh authored
63 {ok, <<Chunk:Size/binary, "\r\n">>} =
c21117c @oscarh Fix indentation
oscarh authored
64 Module:recv(Socket, Size + 2),
4972189 @oscarh Adding test cases for partial upload.
oscarh authored
65 read_chunks(Module, Socket, [Chunk | Acc])
66 end;
67 {error, Reason} ->
68 erlang:error(Reason)
69 end.
70
71 read_trailers(Module, Socket, Hdrs) ->
72 case Module:recv(Socket, 0) of
73 {ok, {http_header, _, Name, _, Value}} when is_atom(Name) ->
74 Trailer = {atom_to_list(Name), Value},
75 read_trailers(Module, Socket, [Trailer | Hdrs]);
76 {ok, {http_header, _, Name, _, Value}} when is_list(Name) ->
77 Trailer = {Name, Value},
78 read_trailers(Module, Socket, [Trailer | Hdrs]);
480be44 @oscarh Read chunks correctly in test web server.
oscarh authored
79 {ok, http_eoh} -> Hdrs
4972189 @oscarh Adding test cases for partial upload.
oscarh authored
80 end.
81
e56b4d3 @oscarh Add test cases.
oscarh authored
82 server_loop(Module, Socket, _, _, []) ->
83 Module:close(Socket);
84 server_loop(Module, Socket, Request, Headers, Responders) ->
85 case Module:recv(Socket, 0) of
86 {ok, {http_request, _, _, _} = NewRequest} ->
87 server_loop(Module, Socket, NewRequest, Headers, Responders);
10cd515 @oscarh Fix header reading in the test webserver.
oscarh authored
88 {ok, {http_header, _, Field, _, Value}} when is_atom(Field) ->
89 NewHeaders = [{atom_to_list(Field), Value} | Headers],
90 server_loop(Module, Socket, Request, NewHeaders, Responders);
91 {ok, {http_header, _, Field, _, Value}} when is_list(Field) ->
e56b4d3 @oscarh Add test cases.
oscarh authored
92 NewHeaders = [{Field, Value} | Headers],
93 server_loop(Module, Socket, Request, NewHeaders, Responders);
94 {ok, http_eoh} ->
552ba9c @oscarh Headers fields are now strings...
oscarh authored
95 RequestBody = case proplists:get_value("Content-Length", Headers) of
e56b4d3 @oscarh Add test cases.
oscarh authored
96 undefined ->
97 <<>>;
98 "0" ->
99 <<>>;
100 SLength ->
101 Length = list_to_integer(SLength),
102 setopts(Module, Socket, [{packet, raw}]),
103 {ok, Body} = Module:recv(Socket, Length),
104 setopts(Module, Socket, [{packet, http}]),
105 Body
106 end,
107 Responder = hd(Responders),
108 Responder(Module, Socket, Request, Headers, RequestBody),
52119c0 @oscarh Add test for socket from client.
oscarh authored
109 server_loop(Module, Socket, none, [], tl(Responders));
110 {error, closed} ->
111 Module:close(Socket)
e56b4d3 @oscarh Add test cases.
oscarh authored
112 end.
113
5d86992 @oscarh Add / fix ssl tests
oscarh authored
114 listen(ssl) ->
9b28217 @oscarh More tests
oscarh authored
115 Opts = [
116 {packet, http},
117 binary,
118 {active, false},
119 {ip, {127,0,0,1}},
5d86992 @oscarh Add / fix ssl tests
oscarh authored
120 {verify,0},
d34fc40 @oscarh Rebar support.
oscarh authored
121 {keyfile, "../test/key.pem"},
122 {certfile, "../test/crt.pem"}
5d86992 @oscarh Add / fix ssl tests
oscarh authored
123 ],
124 {ok, LS} = ssl:listen(0, Opts),
125 LS;
126 listen(Module) ->
9b28217 @oscarh More tests
oscarh authored
127 {ok, LS} = Module:listen(0, [
128 {packet, http},
129 binary,
130 {active, false},
131 {ip, {127,0,0,1}}
132 ]),
5d86992 @oscarh Add / fix ssl tests
oscarh authored
133 LS.
134
e56b4d3 @oscarh Add test cases.
oscarh authored
135 accept(ssl, ListenSocket) ->
5d86992 @oscarh Add / fix ssl tests
oscarh authored
136 {ok, Socket} = ssl:transport_accept(ListenSocket, 10000),
e56b4d3 @oscarh Add test cases.
oscarh authored
137 ok = ssl:ssl_accept(Socket),
138 Socket;
139 accept(Module, ListenSocket) ->
140 {ok, Socket} = Module:accept(ListenSocket, 1000),
141 Socket.
142
143 setopts(ssl, Socket, Options) ->
144 ssl:setopts(Socket, Options);
145 setopts(_, Socket, Options) ->
146 inet:setopts(Socket, Options).
147
148 port(ssl, Socket) ->
149 {ok, {_, Port}} = ssl:sockname(Socket),
150 Port;
151 port(_, Socket) ->
152 {ok, Port} = inet:port(Socket),
153 Port.
4972189 @oscarh Adding test cases for partial upload.
oscarh authored
154
155 chunk_size(<<$;, _/binary>>, Acc) ->
480be44 @oscarh Read chunks correctly in test web server.
oscarh authored
156 erlang:list_to_integer(lists:reverse(Acc), 16);
4972189 @oscarh Adding test cases for partial upload.
oscarh authored
157 chunk_size(<<"\r\n">>, Acc) ->
480be44 @oscarh Read chunks correctly in test web server.
oscarh authored
158 erlang:list_to_integer(lists:reverse(Acc), 16);
4972189 @oscarh Adding test cases for partial upload.
oscarh authored
159 chunk_size(<<Char, Rest/binary>>, Acc) ->
160 chunk_size(Rest, [Char | Acc]).
Something went wrong with that request. Please try again.