Added Fusco source code dependency from https://github.com/dcorbacho/fusco
This commit is contained in:
Badlop
parent
7d0f6caa33
commit
5d6f6b820f
|
|
@ -0,0 +1,177 @@
|
|||
|
||||
Apache License
|
||||
Version 2.0, January 2004
|
||||
http://www.apache.org/licenses/
|
||||
|
||||
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
|
||||
|
||||
1. Definitions.
|
||||
|
||||
"License" shall mean the terms and conditions for use, reproduction,
|
||||
and distribution as defined by Sections 1 through 9 of this document.
|
||||
|
||||
"Licensor" shall mean the copyright owner or entity authorized by
|
||||
the copyright owner that is granting the License.
|
||||
|
||||
"Legal Entity" shall mean the union of the acting entity and all
|
||||
other entities that control, are controlled by, or are under common
|
||||
control with that entity. For the purposes of this definition,
|
||||
"control" means (i) the power, direct or indirect, to cause the
|
||||
direction or management of such entity, whether by contract or
|
||||
otherwise, or (ii) ownership of fifty percent (50%) or more of the
|
||||
outstanding shares, or (iii) beneficial ownership of such entity.
|
||||
|
||||
"You" (or "Your") shall mean an individual or Legal Entity
|
||||
exercising permissions granted by this License.
|
||||
|
||||
"Source" form shall mean the preferred form for making modifications,
|
||||
including but not limited to software source code, documentation
|
||||
source, and configuration files.
|
||||
|
||||
"Object" form shall mean any form resulting from mechanical
|
||||
transformation or translation of a Source form, including but
|
||||
not limited to compiled object code, generated documentation,
|
||||
and conversions to other media types.
|
||||
|
||||
"Work" shall mean the work of authorship, whether in Source or
|
||||
Object form, made available under the License, as indicated by a
|
||||
copyright notice that is included in or attached to the work
|
||||
(an example is provided in the Appendix below).
|
||||
|
||||
"Derivative Works" shall mean any work, whether in Source or Object
|
||||
form, that is based on (or derived from) the Work and for which the
|
||||
editorial revisions, annotations, elaborations, or other modifications
|
||||
represent, as a whole, an original work of authorship. For the purposes
|
||||
of this License, Derivative Works shall not include works that remain
|
||||
separable from, or merely link (or bind by name) to the interfaces of,
|
||||
the Work and Derivative Works thereof.
|
||||
|
||||
"Contribution" shall mean any work of authorship, including
|
||||
the original version of the Work and any modifications or additions
|
||||
to that Work or Derivative Works thereof, that is intentionally
|
||||
submitted to Licensor for inclusion in the Work by the copyright owner
|
||||
or by an individual or Legal Entity authorized to submit on behalf of
|
||||
the copyright owner. For the purposes of this definition, "submitted"
|
||||
means any form of electronic, verbal, or written communication sent
|
||||
to the Licensor or its representatives, including but not limited to
|
||||
communication on electronic mailing lists, source code control systems,
|
||||
and issue tracking systems that are managed by, or on behalf of, the
|
||||
Licensor for the purpose of discussing and improving the Work, but
|
||||
excluding communication that is conspicuously marked or otherwise
|
||||
designated in writing by the copyright owner as "Not a Contribution."
|
||||
|
||||
"Contributor" shall mean Licensor and any individual or Legal Entity
|
||||
on behalf of whom a Contribution has been received by Licensor and
|
||||
subsequently incorporated within the Work.
|
||||
|
||||
2. Grant of Copyright License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
copyright license to reproduce, prepare Derivative Works of,
|
||||
publicly display, publicly perform, sublicense, and distribute the
|
||||
Work and such Derivative Works in Source or Object form.
|
||||
|
||||
3. Grant of Patent License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
(except as stated in this section) patent license to make, have made,
|
||||
use, offer to sell, sell, import, and otherwise transfer the Work,
|
||||
where such license applies only to those patent claims licensable
|
||||
by such Contributor that are necessarily infringed by their
|
||||
Contribution(s) alone or by combination of their Contribution(s)
|
||||
with the Work to which such Contribution(s) was submitted. If You
|
||||
institute patent litigation against any entity (including a
|
||||
cross-claim or counterclaim in a lawsuit) alleging that the Work
|
||||
or a Contribution incorporated within the Work constitutes direct
|
||||
or contributory patent infringement, then any patent licenses
|
||||
granted to You under this License for that Work shall terminate
|
||||
as of the date such litigation is filed.
|
||||
|
||||
4. Redistribution. You may reproduce and distribute copies of the
|
||||
Work or Derivative Works thereof in any medium, with or without
|
||||
modifications, and in Source or Object form, provided that You
|
||||
meet the following conditions:
|
||||
|
||||
(a) You must give any other recipients of the Work or
|
||||
Derivative Works a copy of this License; and
|
||||
|
||||
(b) You must cause any modified files to carry prominent notices
|
||||
stating that You changed the files; and
|
||||
|
||||
(c) You must retain, in the Source form of any Derivative Works
|
||||
that You distribute, all copyright, patent, trademark, and
|
||||
attribution notices from the Source form of the Work,
|
||||
excluding those notices that do not pertain to any part of
|
||||
the Derivative Works; and
|
||||
|
||||
(d) If the Work includes a "NOTICE" text file as part of its
|
||||
distribution, then any Derivative Works that You distribute must
|
||||
include a readable copy of the attribution notices contained
|
||||
within such NOTICE file, excluding those notices that do not
|
||||
pertain to any part of the Derivative Works, in at least one
|
||||
of the following places: within a NOTICE text file distributed
|
||||
as part of the Derivative Works; within the Source form or
|
||||
documentation, if provided along with the Derivative Works; or,
|
||||
within a display generated by the Derivative Works, if and
|
||||
wherever such third-party notices normally appear. The contents
|
||||
of the NOTICE file are for informational purposes only and
|
||||
do not modify the License. You may add Your own attribution
|
||||
notices within Derivative Works that You distribute, alongside
|
||||
or as an addendum to the NOTICE text from the Work, provided
|
||||
that such additional attribution notices cannot be construed
|
||||
as modifying the License.
|
||||
|
||||
You may add Your own copyright statement to Your modifications and
|
||||
may provide additional or different license terms and conditions
|
||||
for use, reproduction, or distribution of Your modifications, or
|
||||
for any such Derivative Works as a whole, provided Your use,
|
||||
reproduction, and distribution of the Work otherwise complies with
|
||||
the conditions stated in this License.
|
||||
|
||||
5. Submission of Contributions. Unless You explicitly state otherwise,
|
||||
any Contribution intentionally submitted for inclusion in the Work
|
||||
by You to the Licensor shall be under the terms and conditions of
|
||||
this License, without any additional terms or conditions.
|
||||
Notwithstanding the above, nothing herein shall supersede or modify
|
||||
the terms of any separate license agreement you may have executed
|
||||
with Licensor regarding such Contributions.
|
||||
|
||||
6. Trademarks. This License does not grant permission to use the trade
|
||||
names, trademarks, service marks, or product names of the Licensor,
|
||||
except as required for reasonable and customary use in describing the
|
||||
origin of the Work and reproducing the content of the NOTICE file.
|
||||
|
||||
7. Disclaimer of Warranty. Unless required by applicable law or
|
||||
agreed to in writing, Licensor provides the Work (and each
|
||||
Contributor provides its Contributions) on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
|
||||
implied, including, without limitation, any warranties or conditions
|
||||
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
|
||||
PARTICULAR PURPOSE. You are solely responsible for determining the
|
||||
appropriateness of using or redistributing the Work and assume any
|
||||
risks associated with Your exercise of permissions under this License.
|
||||
|
||||
8. Limitation of Liability. In no event and under no legal theory,
|
||||
whether in tort (including negligence), contract, or otherwise,
|
||||
unless required by applicable law (such as deliberate and grossly
|
||||
negligent acts) or agreed to in writing, shall any Contributor be
|
||||
liable to You for damages, including any direct, indirect, special,
|
||||
incidental, or consequential damages of any character arising as a
|
||||
result of this License or out of the use or inability to use the
|
||||
Work (including but not limited to damages for loss of goodwill,
|
||||
work stoppage, computer failure or malfunction, or any and all
|
||||
other commercial damages or losses), even if such Contributor
|
||||
has been advised of the possibility of such damages.
|
||||
|
||||
9. Accepting Warranty or Additional Liability. While redistributing
|
||||
the Work or Derivative Works thereof, You may choose to offer,
|
||||
and charge a fee for, acceptance of support, warranty, indemnity,
|
||||
or other liability obligations and/or rights consistent with this
|
||||
License. However, in accepting such obligations, You may act only
|
||||
on Your own behalf and on Your sole responsibility, not on behalf
|
||||
of any other Contributor, and only if You agree to indemnify,
|
||||
defend, and hold each Contributor harmless for any liability
|
||||
incurred by, or claims asserted against, such Contributor by reason
|
||||
of your accepting any such warranty or additional liability.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
.PHONY: all release compile test clean rel doc build-plt dialyzer
|
||||
|
||||
PROJECT = fusco
|
||||
|
||||
REBAR := ./rebar
|
||||
DIALYZER = dialyzer
|
||||
|
||||
APPS = kernel stdlib sasl inets ssl public_key crypto compiler
|
||||
|
||||
all: compile doc
|
||||
|
||||
compile:
|
||||
$(REBAR) compile
|
||||
|
||||
doc:
|
||||
$(REBAR) doc
|
||||
|
||||
test: compile
|
||||
$(REBAR) eunit ct
|
||||
|
||||
release: all dialyze test
|
||||
$(REBAR) release
|
||||
|
||||
clean:
|
||||
$(REBAR) clean
|
||||
|
||||
build-plt: compile
|
||||
@$(DIALYZER) --build_plt --output_plt .$(PROJECT).plt \
|
||||
--apps $(APPS)
|
||||
|
||||
dialyzer:
|
||||
@$(DIALYZER) --fullpath --src ./src \
|
||||
--plt .$(PROJECT).plt --no_native \
|
||||
-Werror_handling #-Wrace_conditions
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
FUSCO
|
||||
=====
|
||||
|
||||
Fast and Ultra Slim Connection Oriented HTTP Client
|
||||
|
||||
Fusco is an Erlang HTTP client for high performance applications.
|
||||
For all those who need a generic HTTP client, check [lhttpc](https://github.com/esl/lhttpc) in which development is based Fusco. Not all the functionalities of lhttpc are present here.
|
||||
|
||||
Fusco is still in a very early stage of development, be aware of that!
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
{import, [".eunit/eunit.coverdata"]}.
|
||||
{export, ["logs/total.coverdata"]}.
|
||||
{incl_dirs, ["ebin"]}.
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
%%% ----------------------------------------------------------------------------
|
||||
%%% Copyright (c) 2009, Erlang Training and Consulting Ltd.
|
||||
%%% All rights reserved.
|
||||
%%%
|
||||
%%% Redistribution and use in source and binary forms, with or without
|
||||
%%% modification, are permitted provided that the following conditions are met:
|
||||
%%% * Redistributions of source code must retain the above copyright
|
||||
%%% notice, this list of conditions and the following disclaimer.
|
||||
%%% * Redistributions in binary form must reproduce the above copyright
|
||||
%%% notice, this list of conditions and the following disclaimer in the
|
||||
%%% documentation and/or other materials provided with the distribution.
|
||||
%%% * Neither the name of Erlang Training and Consulting Ltd. nor the
|
||||
%%% names of its contributors may be used to endorse or promote products
|
||||
%%% derived from this software without specific prior written permission.
|
||||
%%%
|
||||
%%% THIS SOFTWARE IS PROVIDED BY Erlang Training and Consulting Ltd. ''AS IS''
|
||||
%%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
%%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
%%% ARE DISCLAIMED. IN NO EVENT SHALL Erlang Training and Consulting Ltd. BE
|
||||
%%% LIABLE SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
|
||||
%%% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
%%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
%%% OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
%%% ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
%%% ----------------------------------------------------------------------------
|
||||
|
||||
-record(fusco_url, {
|
||||
host :: string(),
|
||||
port :: integer(),
|
||||
path :: string(),
|
||||
is_ssl:: boolean(),
|
||||
user = "" :: string(),
|
||||
password = "" :: string()
|
||||
}).
|
||||
|
||||
-record(fusco_cookie, {
|
||||
name :: binary(),
|
||||
value :: binary(),
|
||||
expires :: {{integer(), integer(), integer()},
|
||||
{integer(), integer(), integer()}} | atom(),
|
||||
path :: binary(),
|
||||
path_tokens :: [binary()],
|
||||
max_age :: integer() | atom(),
|
||||
domain :: binary()
|
||||
}).
|
||||
|
||||
-record(response, {socket,
|
||||
ssl,
|
||||
version,
|
||||
status_code,
|
||||
reason,
|
||||
headers = [],
|
||||
connection,
|
||||
cookies = [],
|
||||
content_length = 0,
|
||||
size,
|
||||
in_timestamp,
|
||||
transfer_encoding,
|
||||
body}).
|
||||
|
||||
-ifdef(no_binary_to_integer).
|
||||
|
||||
-import(fusco_binary, [binary_to_integer/1,
|
||||
integer_to_binary/1]).
|
||||
|
||||
-endif.
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
%%% ----------------------------------------------------------------------------
|
||||
%%% Copyright (c) 2009, Erlang Training and Consulting Ltd.
|
||||
%%% All rights reserved.
|
||||
%%%
|
||||
%%% Redistribution and use in source and binary forms, with or without
|
||||
%%% modification, are permitted provided that the following conditions are met:
|
||||
%%% * Redistributions of source code must retain the above copyright
|
||||
%%% notice, this list of conditions and the following disclaimer.
|
||||
%%% * Redistributions in binary form must reproduce the above copyright
|
||||
%%% notice, this list of conditions and the following disclaimer in the
|
||||
%%% documentation and/or other materials provided with the distribution.
|
||||
%%% * Neither the name of Erlang Training and Consulting Ltd. nor the
|
||||
%%% names of its contributors may be used to endorse or promote products
|
||||
%%% derived from this software without specific prior written permission.
|
||||
%%%
|
||||
%%% THIS SOFTWARE IS PROVIDED BY Erlang Training and Consulting Ltd. ''AS IS''
|
||||
%%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
%%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
%%% ARE DISCLAIMED. IN NO EVENT SHALL Erlang Training and Consulting Ltd. BE
|
||||
%%% LIABLE SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
|
||||
%%% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
%%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
%%% OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
%%% ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
%%% ----------------------------------------------------------------------------
|
||||
|
||||
-type header() :: binary().
|
||||
|
||||
-type headers() :: [{header(), iodata()}].
|
||||
|
||||
-type method() :: string().
|
||||
|
||||
-type pos_timeout() :: pos_integer() | 'infinity'.
|
||||
|
||||
-type socket() :: _.
|
||||
|
||||
-type port_num() :: 1..65535.
|
||||
|
||||
-type invalid_option() :: any().
|
||||
|
||||
-type destination() :: {string(), pos_integer(), boolean()}.
|
||||
|
||||
-type option() ::
|
||||
{'connect_timeout', timeout()} |
|
||||
{'send_retry', non_neg_integer()} |
|
||||
{'connect_options', socket_options()} |
|
||||
{'use_cookies', boolean()} |
|
||||
{'proxy', string()} |
|
||||
{'proxy_ssl_options', socket_options()} |
|
||||
invalid_option().
|
||||
|
||||
-type options() :: [option()].
|
||||
|
||||
-type host() :: string() | {integer(), integer(), integer(), integer()}.
|
||||
|
||||
-type socket_options() :: [{atom(), term()} | atom()].
|
||||
|
||||
-type body() :: binary() |
|
||||
'undefined' | % HEAD request.
|
||||
pid(). % When partial_download option is used.
|
||||
|
||||
-type result() ::
|
||||
{ok, {pos_integer(), headers(), body(),
|
||||
non_neg_integer(), pos_timeout()}} |
|
||||
{error, atom()}.
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
=============================================================================
|
||||
9fedc1ee82661eb6cbf54153198542fcbe51f771 - With http packets on sockets
|
||||
|
||||
HIPE compilation
|
||||
|
||||
Process | RPS
|
||||
-------------------
|
||||
20 | 16891
|
||||
40 | 17048
|
||||
|
||||
Without HIPE compilation
|
||||
|
||||
Process | RPS
|
||||
-------------------
|
||||
20 | 14249
|
||||
40 | 13507
|
||||
|
||||
=============================================================================
|
||||
1cb83bb70fffa37f3b51d874f15f0a1d21b72378 - With raw packets on sockets
|
||||
|
||||
HIPE compilation
|
||||
|
||||
Process | RPS
|
||||
-------------------
|
||||
20 | 19651
|
||||
40 | 20088
|
||||
|
||||
Without HIPE compilation
|
||||
|
||||
Process | RPS
|
||||
-------------------
|
||||
20 | 18577
|
||||
40 | 18601
|
||||
|
||||
Comparison between gen_tcp:recv on http packets and decoding from lhttpc_protocol
|
||||
|
||||
Gen_tcp
|
||||
|
||||
Process | RPS
|
||||
-------------------
|
||||
20 | 32214
|
||||
40 | 31731
|
||||
|
||||
lhttpc_protocol - without HIPE
|
||||
|
||||
Process | RPS
|
||||
-------------------
|
||||
20 | 25658
|
||||
40 | 27448
|
||||
|
||||
|
||||
lhttpc_protocol -HIPE
|
||||
|
||||
Process | RPS
|
||||
-------------------
|
||||
20 | 55814
|
||||
40 | 49963
|
||||
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,6 @@
|
|||
{erl_opts, [debug_info,
|
||||
{platform_define, "R1[45]", no_binary_to_integer}]}.
|
||||
{eunit_opts, [verbose, {report,{eunit_surefire,[{dir,"."}]}}]}.
|
||||
{cover_enabled, true}.
|
||||
{cover_export_enabled, true}.
|
||||
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%%=============================================================================
|
||||
{application, fusco,
|
||||
[{description, "Fast and Ultra Slim Connection Oriented HTTP Client"},
|
||||
{vsn, "0.0.0"},
|
||||
{modules, []},
|
||||
{registered, []},
|
||||
{applications, [kernel, stdlib, ssl]},
|
||||
{env, []}
|
||||
]}.
|
||||
|
||||
|
|
@ -0,0 +1,642 @@
|
|||
%%% ----------------------------------------------------------------------------
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Oscar Hellström <oscar@hellstrom.st>
|
||||
%%% @author Diana Parra Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @author Ramon Lastres Guerrero <ramon.lastres@erlang-solutions.com>
|
||||
%%% @doc Fast and Ultra Slim Connection Oriented HTTP Client
|
||||
%%%
|
||||
%%% @end
|
||||
%%%-----------------------------------------------------------------------------
|
||||
-module(fusco).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
%exported functions
|
||||
-export([start/2,
|
||||
start_link/2,
|
||||
connect/1,
|
||||
request/6,
|
||||
request/7,
|
||||
disconnect/1]).
|
||||
|
||||
%% gen_server callbacks
|
||||
-export([init/1,
|
||||
handle_call/3,
|
||||
handle_cast/2,
|
||||
handle_info/2,
|
||||
terminate/2,
|
||||
code_change/3]).
|
||||
|
||||
-include("fusco_types.hrl").
|
||||
-include("fusco.hrl").
|
||||
|
||||
-export_type([header/0,
|
||||
headers/0,
|
||||
method/0,
|
||||
pos_timeout/0,
|
||||
socket/0,
|
||||
port_num/0,
|
||||
invalid_option/0,
|
||||
destination/0,
|
||||
option/0,
|
||||
options/0,
|
||||
host/0,
|
||||
socket_options/0,
|
||||
body/0,
|
||||
result/0]).
|
||||
|
||||
-define(HTTP_LINE_END, "\r\n").
|
||||
|
||||
-record(client_state, {
|
||||
host :: string(),
|
||||
port = 80 :: port_num(),
|
||||
ssl = false :: boolean(),
|
||||
socket,
|
||||
connect_timeout = 'infinity' :: timeout(),
|
||||
connect_options = [] :: [any()],
|
||||
%% next fields are specific to particular requests
|
||||
request :: iolist() | undefined,
|
||||
connection_header,
|
||||
requester,
|
||||
cookies = [] :: [#fusco_cookie{}],
|
||||
use_cookies = false :: boolean(),
|
||||
%% in case of infinity we read whatever data we can get from
|
||||
%% the wire at that point
|
||||
attempts = 0 :: integer(),
|
||||
proxy :: undefined | #fusco_url{},
|
||||
proxy_ssl_options = [] :: [any()],
|
||||
host_header,
|
||||
out_timestamp,
|
||||
in_timestamp,
|
||||
on_connect,
|
||||
recv_timeout = 'infinity' :: timeout()
|
||||
}).
|
||||
|
||||
%%==============================================================================
|
||||
%% Exported functions
|
||||
%%==============================================================================
|
||||
start(Destination, Options) ->
|
||||
verify_options(Options),
|
||||
gen_server:start(?MODULE, {Destination, Options}, []).
|
||||
|
||||
start_link(Destination, Options) ->
|
||||
verify_options(Options),
|
||||
gen_server:start_link(?MODULE, {Destination, Options}, []).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc Starts a Client.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
connect(Client) ->
|
||||
gen_server:call(Client, connect).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc Stops a Client.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec disconnect(pid()) -> ok.
|
||||
disconnect(Client) ->
|
||||
gen_server:cast(Client, stop).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc Makes a request using a client already connected.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec request(pid(), string(), method(), headers(), iodata(), pos_timeout()) -> result().
|
||||
request(Client, Path, Method, Hdrs, Body, Timeout) ->
|
||||
request(Client, Path, Method, Hdrs, Body, 1, Timeout).
|
||||
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec (Client, Host, Method, Hdrs, RequestBody, RetryCount, Timeout) -> Result
|
||||
%% Host = string()
|
||||
%% Method = string() | atom()
|
||||
%% Hdrs = [{Header, Value}]
|
||||
%% Header = string() | binary() | atom()
|
||||
%% Value = string() | binary()
|
||||
%% RequestBody = iodata()
|
||||
%% RetryCount = integer()
|
||||
%% Timeout = integer() | infinity
|
||||
%% Result = {ok, {{StatusCode, ReasonPhrase}, Hdrs, ResponseBody}}
|
||||
%% | {error, Reason}
|
||||
%% StatusCode = integer()
|
||||
%% ReasonPhrase = string()
|
||||
%% ResponseBody = binary() | pid() | undefined
|
||||
%% Reason = connection_closed | connect_timeout | timeout
|
||||
%% @doc Sends a request with a body.
|
||||
%%
|
||||
%% Instead of building and parsing URLs the target server is specified with
|
||||
%% a host, port, weither SSL should be used or not and a path on the server.
|
||||
%% For instance, if you want to request http://example.com/foobar you would
|
||||
%% use the following:<br/>
|
||||
%% `Host' = `"example.com"'<br/>
|
||||
%% `Port' = `80'<br/>
|
||||
%% `Ssl' = `false'<br/>
|
||||
%% `Path' = `"/foobar"'<br/>
|
||||
%% `Path' must begin with a forward slash `/'.
|
||||
%%
|
||||
%% `Method' is either a string, stating the HTTP method exactly as in the
|
||||
%% protocol, i.e: `"POST"' or `"GET"'. It could also be an atom, which is
|
||||
%% then coverted to an uppercase (if it isn't already) string.
|
||||
%%
|
||||
%% `Hdrs' is a list of headers to send. Mandatory headers such as
|
||||
%% `Host', `Content-Length' or `Transfer-Encoding' (for some requests)
|
||||
%% are added automatically.
|
||||
%%
|
||||
%% `Body' is the entity to send in the request. Please don't include entity
|
||||
%% bodies where there shouldn't be any (such as for `GET').
|
||||
%%
|
||||
%% `Timeout' is the timeout for the request in milliseconds.
|
||||
%%
|
||||
%% `Options' is a list of options.
|
||||
%%
|
||||
%% Options:
|
||||
%%
|
||||
%% `{connect_timeout, Milliseconds}' specifies how many milliseconds the
|
||||
%% client can spend trying to establish a connection to the server. This
|
||||
%% doesn't affect the overall request timeout. However, if it's longer than
|
||||
%% the overall timeout it will be ignored. Also note that the TCP layer my
|
||||
%% choose to give up earlier than the connect timeout, in which case the
|
||||
%% client will also give up. The default value is infinity, which means that
|
||||
%% it will either give up when the TCP stack gives up, or when the overall
|
||||
%% request timeout is reached.
|
||||
%%
|
||||
%% `{connect_options, Options}' specifies options to pass to the socket at
|
||||
%% connect time. This makes it possible to specify both SSL options and
|
||||
%% regular socket options, such as which IP/Port to connect from etc.
|
||||
%% Some options must not be included here, namely the mode, `binary'
|
||||
%% or `list', `{active, boolean()}', `{active, once}' or `{packet, Packet}'.
|
||||
%% These options would confuse the client if they are included.
|
||||
%% Please note that these options will only have an effect on *new*
|
||||
%% connections, and it isn't possible for different requests
|
||||
%% to the same host uses different options unless the connection is closed
|
||||
%% between the requests. Using HTTP/1.0 or including the "Connection: close"
|
||||
%% header would make the client close the connection after the first
|
||||
%% response is received.
|
||||
%%
|
||||
%% `{send_retry, N}' specifies how many times the client should retry
|
||||
%% sending a request if the connection is closed after the data has been
|
||||
%% sent. The default value is `1'.
|
||||
%%
|
||||
%% `{proxy, ProxyUrl}' if this option is specified, a proxy server is used as
|
||||
%% an intermediary for all communication with the destination server. The link
|
||||
%% to the proxy server is established with the HTTP CONNECT method (RFC2817).
|
||||
%% Example value: {proxy, "http://john:doe@myproxy.com:3128"}
|
||||
%%
|
||||
%% `{proxy_ssl_options, SslOptions}' this is a list of SSL options to use for
|
||||
%% the SSL session created after the proxy connection is established. For a
|
||||
%% list of all available options, please check OTP's ssl module manpage.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec request(pid(), string(), method(), headers(), iodata(), integer(), pos_timeout()) -> result().
|
||||
request(Client, Path, Method, Hdrs, Body, SendRetry, Timeout) when is_binary(Path) ->
|
||||
gen_server:call(Client, {request, Path, Method, Hdrs, Body, SendRetry, Timeout}, infinity);
|
||||
request(_, _, _, _, _, _, _) ->
|
||||
{error, badarg}.
|
||||
|
||||
%%%===================================================================
|
||||
%%% gen_server callbacks
|
||||
%%%===================================================================
|
||||
init({Destination, Options}) ->
|
||||
ConnectTimeout = fusco_lib:get_value(connect_timeout, Options, infinity),
|
||||
ConnectOptions = fusco_lib:get_value(connect_options, Options, []),
|
||||
UseCookies = fusco_lib:get_value(use_cookies, Options, false),
|
||||
ProxyInfo = fusco_lib:get_value(proxy, Options, false),
|
||||
ProxySsl = fusco_lib:get_value(proxy_ssl_options, Options, []),
|
||||
OnConnectFun = fusco_lib:get_value(on_connect, Options, fun(_) -> ok end),
|
||||
{Host, Port, Ssl} = case Destination of
|
||||
{H, P, S} ->
|
||||
{H, P, S};
|
||||
URL ->
|
||||
#fusco_url{host = H, port = P,
|
||||
is_ssl = S} = fusco_lib:parse_url(URL),
|
||||
{H, P, S}
|
||||
end,
|
||||
Proxy = case ProxyInfo of
|
||||
false ->
|
||||
undefined;
|
||||
{proxy, ProxyUrl} when is_list(ProxyUrl), not Ssl ->
|
||||
%% The point of HTTP CONNECT proxying is to use TLS tunneled in
|
||||
%% a plain HTTP/1.1 connection to the proxy (RFC2817).
|
||||
throw(origin_server_not_https);
|
||||
{proxy, ProxyUrl} when is_list(ProxyUrl) ->
|
||||
fusco_lib:parse_url(ProxyUrl)
|
||||
end,
|
||||
State = #client_state{host = Host, port = Port, ssl = Ssl,
|
||||
connect_timeout = ConnectTimeout,
|
||||
connect_options = ConnectOptions,
|
||||
use_cookies = UseCookies,
|
||||
host_header = fusco_lib:host_header(Host, Port),
|
||||
proxy = Proxy,
|
||||
proxy_ssl_options = ProxySsl,
|
||||
on_connect = OnConnectFun},
|
||||
{ok, State}.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc This function fills in the Client record used in the requests and obtains
|
||||
%% the socket.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
handle_call(connect, _From, #client_state{socket = undefined} = State) ->
|
||||
% if we dont get a keep alive from the previous request, the socket is undefined.
|
||||
case connect_socket(State) of
|
||||
{ok, NewState} ->
|
||||
{reply, ok, NewState};
|
||||
{Error, NewState} ->
|
||||
{reply, Error, NewState}
|
||||
end;
|
||||
handle_call(connect, _From, State) ->
|
||||
{reply, ok, State};
|
||||
handle_call({request, Path, Method, Hdrs, Body, SendRetry, Timeout}, From,
|
||||
State = #client_state{host_header = Host,
|
||||
use_cookies = UseCookies}) ->
|
||||
Cookies = delete_expired_cookies(State),
|
||||
{Request, ConHeader} =
|
||||
fusco_lib:format_request(Path, Method, Hdrs, Host, Body, {UseCookies, Cookies}),
|
||||
send_request(State#client_state{
|
||||
request = Request,
|
||||
requester = From,
|
||||
connection_header = ConHeader,
|
||||
attempts = SendRetry + 1,
|
||||
recv_timeout = Timeout}).
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% Handling cast messages
|
||||
%%
|
||||
%% @spec handle_cast(Msg, State) -> {noreply, State} |
|
||||
%% {noreply, State, Timeout} |
|
||||
%% {stop, Reason, State}
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
handle_cast(stop, State) ->
|
||||
{stop, normal, State};
|
||||
handle_cast(_Msg, State) ->
|
||||
{noreply, State}.
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% Handling all non call/cast messages
|
||||
%%
|
||||
%% @spec handle_info(Info, State) -> {noreply, State} |
|
||||
%% {noreply, State, Timeout} |
|
||||
%% {stop, Reason, State}
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
handle_info(_Info, State) ->
|
||||
{noreply, State}.
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% This function is called by a gen_server when it is about to
|
||||
%% terminate. It should be the opposite of Module:init/1 and do any
|
||||
%% necessary cleaning up. When it returns, the gen_server terminates
|
||||
%% with Reason. The return value is ignored.
|
||||
%%
|
||||
%% @spec terminate(Reason, State) -> void()
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
terminate(_Reason, #client_state{socket = Socket, ssl = Ssl}) ->
|
||||
case Socket of
|
||||
undefined ->
|
||||
ok;
|
||||
_ ->
|
||||
fusco_sock:close(Socket, Ssl),
|
||||
ok
|
||||
end.
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% Convert process state when code is changed
|
||||
%%
|
||||
%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
code_change(_OldVsn, State, _Extra) ->
|
||||
{ok, State}.
|
||||
|
||||
%%==============================================================================
|
||||
%% Internal functions
|
||||
%%==============================================================================
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc This function creates a new socket connection if needed, and it also
|
||||
%% handles the proxy connection.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
send_request(#client_state{attempts = 0} = State) ->
|
||||
{reply, {error, connection_closed}, State};
|
||||
send_request(#client_state{socket = undefined} = State) ->
|
||||
% if we dont get a keep alive from the previous request, the socket is undefined.
|
||||
case connect_socket(State) of
|
||||
{ok, NewState} ->
|
||||
send_request(NewState);
|
||||
{Error, NewState} ->
|
||||
{reply, Error, NewState}
|
||||
end;
|
||||
send_request(#client_state{socket = Socket, ssl = Ssl, request = Request,
|
||||
attempts = Attempts, recv_timeout = RecvTimeout} = State) ->
|
||||
Out = os:timestamp(),
|
||||
%If we have a timeout set then we need to ensure a timeout on sending too
|
||||
fusco_sock:setopts(Socket, [{send_timeout, RecvTimeout}, {send_timeout_close, true}], Ssl),
|
||||
case fusco_sock:send(Socket, Request, Ssl) of
|
||||
ok ->
|
||||
read_response(State#client_state{out_timestamp = Out});
|
||||
{error, closed} ->
|
||||
fusco_sock:close(Socket, Ssl),
|
||||
send_request(State#client_state{socket = undefined, attempts = Attempts - 1});
|
||||
{error, _Reason} ->
|
||||
fusco_sock:close(Socket, Ssl),
|
||||
{reply, {error, connection_closed}, State#client_state{socket = undefined}}
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
request_first_destination(#client_state{proxy = #fusco_url{} = Proxy}) ->
|
||||
{Proxy#fusco_url.host, Proxy#fusco_url.port, Proxy#fusco_url.is_ssl};
|
||||
request_first_destination(#client_state{host = Host, port = Port, ssl = Ssl}) ->
|
||||
{Host, Port, Ssl}.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
read_proxy_connect_response(#client_state{recv_timeout = RecvTimeout} = State) ->
|
||||
Socket = State#client_state.socket,
|
||||
ProxyIsSsl = (State#client_state.proxy)#fusco_url.is_ssl,
|
||||
case fusco_protocol:recv(Socket, ProxyIsSsl, RecvTimeout) of
|
||||
#response{status_code = <<$1,_,_>>} ->
|
||||
%% RFC 2616, section 10.1:
|
||||
%% A client MUST be prepared to accept one or more
|
||||
%% 1xx status responses prior to a regular
|
||||
%% response, even if the client does not expect a
|
||||
%% 100 (Continue) status message. Unexpected 1xx
|
||||
%% status responses MAY be ignored by a user agent.
|
||||
read_proxy_connect_response(State);
|
||||
#response{status_code = <<$2,_,_>>} ->
|
||||
%% RFC2817, any 2xx code means success.
|
||||
ConnectOptions = State#client_state.connect_options,
|
||||
SslOptions = State#client_state.proxy_ssl_options,
|
||||
Timeout = State#client_state.connect_timeout,
|
||||
case ssl:connect(Socket, SslOptions ++ ConnectOptions, Timeout) of
|
||||
{ok, SslSocket} ->
|
||||
{ok, SslSocket};
|
||||
{error, Reason} ->
|
||||
fusco_sock:close(State#client_state.socket, State#client_state.ssl),
|
||||
{error, {proxy_connection_failed, Reason}}
|
||||
end;
|
||||
#response{status_code = StatusCode, reason = Reason} ->
|
||||
{error, {proxy_connection_refused, StatusCode, Reason}};
|
||||
{error, closed} ->
|
||||
fusco_sock:close(Socket, ProxyIsSsl),
|
||||
{error, proxy_connection_closed};
|
||||
{error, Reason} ->
|
||||
{error, {proxy_connection_failed, Reason}}
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc @TODO This does not handle redirects at the moment.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec read_response(#client_state{}) -> {any(), socket()} | no_return().
|
||||
read_response(#client_state{socket = Socket, ssl = Ssl, use_cookies = UseCookies,
|
||||
connection_header = ConHdr, cookies = Cookies,
|
||||
requester = From, out_timestamp = Out, attempts = Attempts,
|
||||
recv_timeout = RecvTimeout} = State) ->
|
||||
case fusco_protocol:recv(Socket, Ssl, RecvTimeout) of
|
||||
#response{status_code = <<$1,_,_>>} ->
|
||||
%% RFC 2616, section 10.1:
|
||||
%% A client MUST be prepared to accept one or more
|
||||
%% 1xx status responses prior to a regular
|
||||
%% response, even if the client does not expect a
|
||||
%% 100 (Continue) status message. Unexpected 1xx
|
||||
%% status responses MAY be ignored by a user agent.
|
||||
read_response(State);
|
||||
#response{version = Vsn, cookies = NewCookies, connection = Connection,
|
||||
status_code = Status, reason = Reason, headers = Headers,
|
||||
body = Body, size = Size, in_timestamp = In}->
|
||||
gen_server:reply(
|
||||
From,
|
||||
{ok, {{Status, Reason}, Headers, Body, Size,
|
||||
timer:now_diff(In, Out)}}),
|
||||
case maybe_close_socket(Connection, State, Vsn, ConHdr) of
|
||||
undefined ->
|
||||
case UseCookies of
|
||||
true ->
|
||||
{noreply, State#client_state{socket = undefined,
|
||||
cookies = fusco_lib:update_cookies(NewCookies, Cookies),
|
||||
in_timestamp = In}};
|
||||
false ->
|
||||
{noreply, State#client_state{socket = undefined}}
|
||||
end;
|
||||
_ ->
|
||||
case UseCookies of
|
||||
true ->
|
||||
{noreply, State#client_state{cookies = fusco_lib:update_cookies(NewCookies, Cookies),
|
||||
in_timestamp = In}};
|
||||
_ ->
|
||||
{noreply, State}
|
||||
end
|
||||
end;
|
||||
{error, closed} ->
|
||||
% Either we only noticed that the socket was closed after we
|
||||
% sent the request, the server closed it just after we put
|
||||
% the request on the wire or the server has some isses and is
|
||||
% closing connections without sending responses.
|
||||
% If this the first attempt to send the request, we will try again.
|
||||
fusco_sock:close(Socket, Ssl),
|
||||
send_request(State#client_state{socket = undefined, attempts = Attempts - 1});
|
||||
{error, Reason} ->
|
||||
fusco_sock:close(Socket, Ssl),
|
||||
{reply, {error, Reason}, State#client_state{socket = undefined}}
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
maybe_close_socket(<<"close">>, #client_state{socket = Socket} = State, {1, 1}, _) ->
|
||||
fusco_sock:close(Socket, State#client_state.ssl),
|
||||
undefined;
|
||||
maybe_close_socket(_, #client_state{socket = Socket}, {1, 1}, undefined) ->
|
||||
Socket;
|
||||
maybe_close_socket(_, #client_state{socket = Socket} = State, {1, 1}, ConHdr) ->
|
||||
ClientConnection = fusco_lib:is_close(ConHdr),
|
||||
if
|
||||
ClientConnection ->
|
||||
fusco_sock:close(Socket, State#client_state.ssl),
|
||||
undefined;
|
||||
(not ClientConnection) ->
|
||||
Socket
|
||||
end;
|
||||
maybe_close_socket(<<"keep-alive">>, #client_state{socket = Socket}, _, undefined) ->
|
||||
Socket;
|
||||
maybe_close_socket(C, #client_state{socket = Socket} = State, _, _)
|
||||
when C =/= <<"keep-alive">> ->
|
||||
fusco_sock:close(Socket, State#client_state.ssl),
|
||||
undefined;
|
||||
maybe_close_socket(_, #client_state{socket = Socket} = State, _, ConHdr) ->
|
||||
ClientConnection = fusco_lib:is_close(ConHdr),
|
||||
if
|
||||
ClientConnection ->
|
||||
fusco_sock:close(Socket, State#client_state.ssl),
|
||||
undefined;
|
||||
(not ClientConnection) ->
|
||||
Socket
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec is_ipv6_host(host()) -> boolean().
|
||||
is_ipv6_host(Host) ->
|
||||
case inet_parse:address(Host) of
|
||||
{ok, {_, _, _, _, _, _, _, _}} ->
|
||||
true;
|
||||
{ok, {_, _, _, _}} ->
|
||||
false;
|
||||
_ ->
|
||||
% Prefer IPv4 over IPv6.
|
||||
case inet:getaddr(Host, inet) of
|
||||
{ok, _} ->
|
||||
false;
|
||||
_ ->
|
||||
case inet:getaddr(Host, inet6) of
|
||||
{ok, _} ->
|
||||
true;
|
||||
_ ->
|
||||
false
|
||||
end
|
||||
end
|
||||
end.
|
||||
|
||||
% What about the timeout?
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% Creates a new socket.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
connect_socket(State) ->
|
||||
case ensure_proxy_tunnel(new_socket(State), State) of
|
||||
{ok, Socket, _} ->
|
||||
{ok, State#client_state{socket = Socket}};
|
||||
Error ->
|
||||
{Error, State}
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc Creates a new socket using the options included in the client state.
|
||||
%% end
|
||||
%%------------------------------------------------------------------------------
|
||||
new_socket(#client_state{connect_timeout = Timeout, connect_options = ConnectOptions,
|
||||
on_connect = OnConnectFun} = State) ->
|
||||
{Host, Port, Ssl} = request_first_destination(State),
|
||||
ConnectOptions2 = case (not lists:member(inet, ConnectOptions)) andalso
|
||||
(not lists:member(inet6, ConnectOptions)) andalso
|
||||
is_ipv6_host(Host) of
|
||||
true ->
|
||||
[inet6 | ConnectOptions];
|
||||
false ->
|
||||
ConnectOptions
|
||||
end,
|
||||
SocketOptions = [binary, {packet, raw}, {nodelay, true}, {reuseaddr, true},
|
||||
{active, false} | ConnectOptions2],
|
||||
Reply = connect(Host, Port, SocketOptions, Timeout, Ssl),
|
||||
OnConnectFun(Reply),
|
||||
Reply.
|
||||
|
||||
connect(Host, Port, SocketOptions, Timeout, Ssl) ->
|
||||
TimeB = os:timestamp(),
|
||||
try fusco_sock:connect(Host, Port, SocketOptions, Timeout, Ssl) of
|
||||
{ok, Socket} ->
|
||||
TimeA = os:timestamp(),
|
||||
ConnectionTime = timer:now_diff(TimeA, TimeB),
|
||||
{ok, Socket, ConnectionTime};
|
||||
{error, etimedout} ->
|
||||
%% TCP stack decided to give up
|
||||
{error, connect_timeout};
|
||||
{error, timeout} ->
|
||||
{error, connect_timeout};
|
||||
{error, 'record overflow'} ->
|
||||
{error, ssl_error};
|
||||
{error, _} = Error ->
|
||||
Error
|
||||
catch
|
||||
exit:{{{badmatch, {error, {asn1, _}}}, _}, _} ->
|
||||
{error, ssl_decode_error};
|
||||
Type:Error ->
|
||||
error_logger:error_msg("Socket connection error: ~p ~p, ~p",
|
||||
[Type, Error, erlang:get_stacktrace()]),
|
||||
{error, connection_error}
|
||||
end.
|
||||
|
||||
ensure_proxy_tunnel({error, _} = Error, _State) ->
|
||||
Error;
|
||||
ensure_proxy_tunnel({ok, Socket}, #client_state{proxy = #fusco_url{user = User,
|
||||
password = Passwd,
|
||||
is_ssl = Ssl},
|
||||
host = DestHost, port = Port} = State) ->
|
||||
%% Proxy tunnel connection http://tools.ietf.org/html/rfc2817#section-5.2
|
||||
%% Draft http://www.web-cache.com/Writings/Internet-Drafts/draft-luotonen-web-proxy-tunneling-01.txt
|
||||
%% IPv6 address literals are enclosed by square brackets (RFC2732)
|
||||
Host = [fusco_lib:maybe_ipv6_enclose(DestHost), $:, integer_to_list(Port)],
|
||||
ConnectRequest = [
|
||||
<<"CONNECT ">>, Host, <<" HTTP/1.1">>, ?HTTP_LINE_END,
|
||||
<<"Host: ">>, Host, ?HTTP_LINE_END,
|
||||
case User of
|
||||
[] ->
|
||||
[];
|
||||
_ ->
|
||||
[<<"Proxy-Authorization: Basic ">>,
|
||||
base64:encode(User ++ ":" ++ Passwd), ?HTTP_LINE_END]
|
||||
end,
|
||||
?HTTP_LINE_END],
|
||||
case fusco_sock:send(Socket, ConnectRequest, Ssl) of
|
||||
ok ->
|
||||
read_proxy_connect_response(State#client_state{socket = Socket});
|
||||
{error, closed} ->
|
||||
fusco_sock:close(Socket, Ssl),
|
||||
{error, proxy_connection_closed};
|
||||
{error, _Reason} ->
|
||||
fusco_sock:close(Socket, Ssl),
|
||||
{error, proxy_connection_closed}
|
||||
end;
|
||||
ensure_proxy_tunnel(Socket, _State) ->
|
||||
Socket.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec verify_options(options()) -> ok | any().
|
||||
verify_options([{connect_timeout, infinity} | Options]) ->
|
||||
verify_options(Options);
|
||||
verify_options([{connect_timeout, MS} | Options])
|
||||
when is_integer(MS), MS >= 0 ->
|
||||
verify_options(Options);
|
||||
verify_options([{connect_options, List} | Options]) when is_list(List) ->
|
||||
verify_options(Options);
|
||||
verify_options([{proxy, List} | Options]) when is_list(List) ->
|
||||
verify_options(Options);
|
||||
verify_options([{proxy_ssl_options, List} | Options]) when is_list(List) ->
|
||||
verify_options(Options);
|
||||
verify_options([{use_cookies, B} | Options]) when is_boolean(B) ->
|
||||
verify_options(Options);
|
||||
verify_options([{on_connect, F} | Options]) when is_function(F) ->
|
||||
verify_options(Options);
|
||||
verify_options([Option | _Rest]) ->
|
||||
erlang:error({bad_option, Option});
|
||||
verify_options([]) ->
|
||||
ok.
|
||||
|
||||
delete_expired_cookies(#client_state{use_cookies = false}) ->
|
||||
[];
|
||||
delete_expired_cookies(#client_state{in_timestamp = undefined,
|
||||
cookies = Cookies}) ->
|
||||
Cookies;
|
||||
delete_expired_cookies(#client_state{in_timestamp = In,
|
||||
cookies = Cookies}) ->
|
||||
fusco_lib:delete_expired_cookies(Cookies, In).
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
-module(fusco_binary).
|
||||
|
||||
-ifdef(no_binary_to_integer).
|
||||
|
||||
-export([binary_to_integer/1,
|
||||
integer_to_binary/1]).
|
||||
|
||||
binary_to_integer(B) ->
|
||||
catch list_to_integer(binary_to_list(B)).
|
||||
|
||||
integer_to_binary(I) ->
|
||||
catch list_to_binary(integer_to_list(I)).
|
||||
|
||||
-endif.
|
||||
|
|
@ -0,0 +1,219 @@
|
|||
%%% ----------------------------------------------------------------------------
|
||||
%%% @copyright (C) 2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Parra Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc Fusco Client Pool
|
||||
%%%
|
||||
%%% Pool of clients connected to the same server. Clients do not share state
|
||||
%%% Recommended for BOSH where connections do not share cookies or any other
|
||||
%%% headers state
|
||||
%%%
|
||||
%%% @end
|
||||
%%%-----------------------------------------------------------------------------
|
||||
-module(fusco_cp).
|
||||
|
||||
-behaviour(gen_server).
|
||||
|
||||
%% API
|
||||
-export([start/3,
|
||||
start_link/3,
|
||||
get_client/1,
|
||||
free_client/2,
|
||||
stop/1
|
||||
]).
|
||||
|
||||
-export([request/7]).
|
||||
|
||||
%% gen_server callbacks
|
||||
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
|
||||
terminate/2, code_change/3]).
|
||||
|
||||
-define(SERVER, ?MODULE).
|
||||
|
||||
-record(state, {destination,
|
||||
options,
|
||||
max,
|
||||
total,
|
||||
free,
|
||||
busy,
|
||||
queue
|
||||
}).
|
||||
|
||||
%%%===================================================================
|
||||
%%% API
|
||||
%%%===================================================================
|
||||
start(Destination, Options, MaxClients) ->
|
||||
verify_max(MaxClients),
|
||||
gen_server:start(?MODULE, [Destination, Options, MaxClients], []).
|
||||
|
||||
start_link(Destination, Options, MaxClients) ->
|
||||
verify_max(MaxClients),
|
||||
gen_server:start_link(?MODULE, [Destination, Options, MaxClients], []).
|
||||
|
||||
get_client(Pool) ->
|
||||
try
|
||||
gen_server:call(Pool, get_client)
|
||||
catch
|
||||
exit:{timeout, _} ->
|
||||
{error, timeout}
|
||||
end.
|
||||
|
||||
free_client(Pool, Client) ->
|
||||
gen_server:cast(Pool, {free_client, Client}).
|
||||
|
||||
stop(Pool) ->
|
||||
gen_server:cast(Pool, stop).
|
||||
|
||||
request(Pool, Path, Method, Hdrs, Body, SendRetry, Timeout) ->
|
||||
case get_client(Pool) of
|
||||
{error, _} = Error ->
|
||||
Error;
|
||||
Client ->
|
||||
Reply = fusco:request(Client, Path, Method, Hdrs, Body, SendRetry,
|
||||
Timeout),
|
||||
free_client(Pool, Client),
|
||||
Reply
|
||||
end.
|
||||
%%%===================================================================
|
||||
%%% gen_server callbacks
|
||||
%%%===================================================================
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% Initializes the server
|
||||
%%
|
||||
%% @spec init(Args) -> {ok, State} |
|
||||
%% {ok, State, Timeout} |
|
||||
%% ignore |
|
||||
%% {stop, Reason}
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
init([Destination, Options, MaxClients]) ->
|
||||
process_flag(trap_exit, true),
|
||||
{ok, #state{destination = Destination,
|
||||
options = Options,
|
||||
total = 0,
|
||||
max = MaxClients,
|
||||
free = [],
|
||||
busy = [],
|
||||
queue = queue:new()
|
||||
}, 0}.
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% Handling call messages
|
||||
%%
|
||||
%% @spec handle_call(Request, From, State) ->
|
||||
%% {reply, Reply, State} |
|
||||
%% {reply, Reply, State, Timeout} |
|
||||
%% {noreply, State} |
|
||||
%% {noreply, State, Timeout} |
|
||||
%% {stop, Reason, Reply, State} |
|
||||
%% {stop, Reason, State}
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
handle_call(get_client, _From, State = #state{free = [Client | Free],
|
||||
busy = Busy}) ->
|
||||
{reply, Client, State#state{free = Free,
|
||||
busy = [Client | Busy]}};
|
||||
handle_call(get_client, _From, State = #state{destination = Destination,
|
||||
options = Options,
|
||||
free = [],
|
||||
max = M,
|
||||
total = T,
|
||||
busy = Busy})
|
||||
when M > T ->
|
||||
{ok, Pid} = fusco:start_link(Destination, Options),
|
||||
{reply, Pid, State#state{total = T + 1,
|
||||
busy = [Pid | Busy]}};
|
||||
handle_call(get_client, From, State = #state{free = [],
|
||||
max = M,
|
||||
total = T,
|
||||
queue = Queue})
|
||||
when M == T ->
|
||||
{noreply, State#state{queue = queue:in(From, Queue)}}.
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% Handling cast messages
|
||||
%%
|
||||
%% @spec handle_cast(Msg, State) -> {noreply, State} |
|
||||
%% {noreply, State, Timeout} |
|
||||
%% {stop, Reason, State}
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
handle_cast({free_client, Pid}, State = #state{free = Free,
|
||||
busy = Busy,
|
||||
queue = Queue}) ->
|
||||
case queue:is_empty(Queue) of
|
||||
true ->
|
||||
{noreply, State#state{free = [Pid | Free],
|
||||
busy = lists:delete(Pid, Busy)}};
|
||||
false ->
|
||||
{{value, From}, Q2} = queue:out(Queue),
|
||||
gen_server:reply(From, Pid),
|
||||
{noreply, State#state{queue = Q2}}
|
||||
end;
|
||||
handle_cast(stop, State) ->
|
||||
{stop, normal, State}.
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% Handling all non call/cast messages
|
||||
%%
|
||||
%% @spec handle_info(Info, State) -> {noreply, State} |
|
||||
%% {noreply, State, Timeout} |
|
||||
%% {stop, Reason, State}
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
handle_info({'EXIT', From, _Reason}, State = #state{free = Free,
|
||||
busy = Busy,
|
||||
total = Total}) ->
|
||||
{noreply, State#state{free = lists:delete(From, Free),
|
||||
busy = lists:delete(From, Busy),
|
||||
total = Total - 1}};
|
||||
handle_info(timeout, #state{free = [], busy = [],
|
||||
destination = Destination,
|
||||
options = Options} = State) ->
|
||||
{ok, Pid} = fusco:start_link(Destination, Options),
|
||||
{noreply, State#state{free = [Pid], total = 1}};
|
||||
handle_info(_Info, State) ->
|
||||
{noreply, State}.
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% This function is called by a gen_server when it is about to
|
||||
%% terminate. It should be the opposite of Module:init/1 and do any
|
||||
%% necessary cleaning up. When it returns, the gen_server terminates
|
||||
%% with Reason. The return value is ignored.
|
||||
%%
|
||||
%% @spec terminate(Reason, State) -> void()
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
terminate(_Reason, #state{free = Free, busy = Busy}) ->
|
||||
[fusco:disconnect(F) || F <- Free],
|
||||
[fusco:disconnect(B) || B <- Busy],
|
||||
ok.
|
||||
|
||||
%%--------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% Convert process state when code is changed
|
||||
%%
|
||||
%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}
|
||||
%% @end
|
||||
%%--------------------------------------------------------------------
|
||||
code_change(_OldVsn, State, _Extra) ->
|
||||
{ok, State}.
|
||||
|
||||
%%%===================================================================
|
||||
%%% Internal functions
|
||||
%%%===================================================================
|
||||
verify_max(Integer) when is_integer(Integer), Integer > 0 ->
|
||||
ok;
|
||||
verify_max(_) ->
|
||||
throw(invalid_parameter).
|
||||
|
|
@ -0,0 +1,498 @@
|
|||
%%%-----------------------------------------------------------------------------
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Oscar Hellström <oscar@hellstrom.st>
|
||||
%%% @author Diana Parra Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @author Ramon Lastres Guerrero <ramon.lastres@erlang-solutions.com>
|
||||
%%% @doc This module implements various library functions used in fusco
|
||||
%%%
|
||||
%%% @end
|
||||
%%%-----------------------------------------------------------------------------
|
||||
-module(fusco_lib).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-export([parse_url/1,
|
||||
format_request/6,
|
||||
header_value/2,
|
||||
update_cookies/2,
|
||||
delete_expired_cookies/2,
|
||||
to_lower/1,
|
||||
get_value/2,
|
||||
get_value/3,
|
||||
host_header/2,
|
||||
is_close/1,
|
||||
maybe_ipv6_enclose/1]).
|
||||
|
||||
-include("fusco_types.hrl").
|
||||
-include("fusco.hrl").
|
||||
|
||||
-define(HTTP_LINE_END, <<"\r\n">>).
|
||||
|
||||
%%==============================================================================
|
||||
%% Exported functions
|
||||
%%==============================================================================
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec header_value(Header, Headers) -> undefined | term()
|
||||
%% Header = string()
|
||||
%% Headers = [{header(), term()}]
|
||||
%% Value = term()
|
||||
%% @doc
|
||||
%% Returns the value associated with the `Header' in `Headers'.
|
||||
%% `Header' must be a lowercase string, since every header is mangled to
|
||||
%% check the match.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec header_value(string(), headers()) -> undefined | term().
|
||||
header_value(Hdr, Hdrs) ->
|
||||
%% TODO ensure headers and values are stripped
|
||||
case lists:keyfind(Hdr, 1, Hdrs) of
|
||||
false ->
|
||||
undefined;
|
||||
{Hdr, Value} ->
|
||||
Value
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec (URL) -> #fusco_url{}
|
||||
%% URL = string()
|
||||
%% @doc
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec parse_url(string()) -> #fusco_url{}.
|
||||
parse_url(URL) ->
|
||||
% XXX This should be possible to do with the re module?
|
||||
{Scheme, CredsHostPortPath} = split_scheme(URL),
|
||||
{User, Passwd, HostPortPath} = split_credentials(CredsHostPortPath),
|
||||
{Host, PortPath} = split_host(HostPortPath, []),
|
||||
{Port, Path} = split_port(Scheme, PortPath, []),
|
||||
#fusco_url{host = fusco_lib:to_lower(Host), port = Port, path = Path,
|
||||
user = User, password = Passwd, is_ssl = (Scheme =:= https)}.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec (Path, Method, Headers, Host, Body, Cookies) ->
|
||||
%% Request
|
||||
%% Path = iolist()
|
||||
%% Method = atom() | string()
|
||||
%% Headers = [{atom() | string(), string()}]
|
||||
%% Host = string()
|
||||
%% Body = iolist()
|
||||
%% Cookies = [#fusco_cookie{}]
|
||||
%% @doc
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec format_request(iolist(), method(), headers(), string(), iolist(),
|
||||
{boolean(), [#fusco_cookie{}]}) -> {iodata(), iodata()}.
|
||||
format_request(Path, Method, Hdrs, Host, Body, Cookies) ->
|
||||
{AllHdrs, ConHdr} =
|
||||
add_mandatory_hdrs(Path, Hdrs, Host, Body, Cookies),
|
||||
{[Method, <<" ">>, Path, <<" HTTP/1.1">>, ?HTTP_LINE_END, AllHdrs,
|
||||
?HTTP_LINE_END, Body], ConHdr}.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc Updated the state of the cookies. after we receive a response.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec update_cookies(headers(), [#fusco_cookie{}]) -> [#fusco_cookie{}].
|
||||
update_cookies([], []) ->
|
||||
[];
|
||||
update_cookies([], StateCookies) ->
|
||||
StateCookies;
|
||||
update_cookies(ReceivedCookies, []) ->
|
||||
ReceivedCookies;
|
||||
update_cookies(ReceivedCookies, StateCookies) ->
|
||||
%% substitute the cookies with the same name, add the others, delete.
|
||||
|
||||
%% http://tools.ietf.org/search/rfc6265#section-4.1.2
|
||||
%% If a user agent receives a Set-Cookie response header whose NAME is
|
||||
%% the same as a pre-existing cookie, and whose Domain and Path
|
||||
%% attribute values exactly (string) match those of a pre-existing
|
||||
%% cookie, the new cookie supersedes the old.
|
||||
lists:foldl(fun(NewCookie, Acc) ->
|
||||
OldCookie =
|
||||
lists:keyfind(NewCookie#fusco_cookie.name,
|
||||
#fusco_cookie.name, Acc),
|
||||
replace_or_add_cookie(OldCookie, NewCookie, Acc)
|
||||
end, StateCookies, ReceivedCookies).
|
||||
|
||||
%% http://tools.ietf.org/search/rfc6265#section-4.1.2
|
||||
replace_or_add_cookie(false, NewCookie, List) ->
|
||||
%% Add new cookie
|
||||
[NewCookie | List];
|
||||
replace_or_add_cookie(#fusco_cookie{domain = Domain, path = Path},
|
||||
#fusco_cookie{domain = Domain,
|
||||
path = Path} = NewCookie, List) ->
|
||||
%% Replace previous cookie
|
||||
lists:keystore(NewCookie#fusco_cookie.name, #fusco_cookie.name, List,
|
||||
NewCookie);
|
||||
replace_or_add_cookie(_, NewCookie, List) ->
|
||||
%% Add new cookie, path and/or domain are different
|
||||
[NewCookie | List].
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc Converts characters in a string ro lower case.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec to_lower(string()) -> string().
|
||||
to_lower(String) when is_list(String) ->
|
||||
[char_to_lower(X) || X <- String].
|
||||
|
||||
bin_to_lower(Bin) ->
|
||||
<< <<(char_to_lower(B))>> || <<B>> <= Bin >>.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc Compares header values to pre-defined values
|
||||
%% Faster than string:to_lower and then compare
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
is_close(<<"close">>) ->
|
||||
true;
|
||||
is_close(<<"Close">>) ->
|
||||
true;
|
||||
is_close(<<"keep-alive">>) ->
|
||||
false;
|
||||
is_close(<<"Keep-Alive">>) ->
|
||||
false;
|
||||
is_close(C) ->
|
||||
is_close(C, "close").
|
||||
|
||||
is_close(<<C, Rest1/bits>>, [C | Rest2]) ->
|
||||
is_close(Rest1, Rest2);
|
||||
is_close(<<C1, Rest1/bits>>, [C2 | Rest2]) ->
|
||||
case close_to_lower(C1) == C2 of
|
||||
true ->
|
||||
is_close(Rest1, Rest2);
|
||||
false ->
|
||||
false
|
||||
end;
|
||||
is_close(<<>>, _) ->
|
||||
false;
|
||||
is_close(_, []) ->
|
||||
false.
|
||||
|
||||
close_to_lower($C) ->
|
||||
$c;
|
||||
close_to_lower($L) ->
|
||||
$l;
|
||||
close_to_lower($O) ->
|
||||
$o;
|
||||
close_to_lower($S) ->
|
||||
$s;
|
||||
close_to_lower($E) ->
|
||||
$e;
|
||||
close_to_lower(C) ->
|
||||
C.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc Gets value from tuple list
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec get_value(Key, List) -> term() when
|
||||
Key :: term(),
|
||||
List :: [term()].
|
||||
get_value(Key, List) ->
|
||||
case lists:keyfind(Key, 1, List) of
|
||||
{Key, Value} ->
|
||||
Value;
|
||||
false ->
|
||||
undefined
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc Gets value from tuple list. If it is not present, returns default value.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec get_value(Key, List, Default) -> term() when
|
||||
Key :: term(),
|
||||
List :: [term()],
|
||||
Default :: term().
|
||||
get_value(Key, List, Default) ->
|
||||
case lists:keyfind(Key, 1, List) of
|
||||
{Key, Value} ->
|
||||
Value;
|
||||
false ->
|
||||
Default
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc Delete the cookies that are expired (check max-age and expire fields).
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec delete_expired_cookies([#fusco_cookie{}], erlang:timestamp()) -> [#fusco_cookie{}].
|
||||
delete_expired_cookies([], _InTimestamp) ->
|
||||
[];
|
||||
delete_expired_cookies(Cookies, InTimestamp) ->
|
||||
[ X || X <- Cookies, not expires(X, InTimestamp)].
|
||||
|
||||
%%==============================================================================
|
||||
%% Internal functions
|
||||
%%==============================================================================
|
||||
%% http://tools.ietf.org/search/rfc6265#section-4.1.2.2
|
||||
%% The Max-Age attribute indicates the maximum lifetime of the cookie,
|
||||
%% represented as the number of seconds until the cookie expires.
|
||||
%%
|
||||
%% If a cookie has both the Max-Age and the Expires attribute,
|
||||
%% the Max-Age attribute has precedence and controls the expiration date of the
|
||||
%% cookie. If a cookie has neither the Max-Age nor the Expires attribute,
|
||||
%% the user agent will retain the cookie until "the current session is over"
|
||||
expires(#fusco_cookie{max_age = 0}, _) ->
|
||||
true;
|
||||
expires(#fusco_cookie{max_age = Max}, InTimestamp) when Max =/= undefined ->
|
||||
timer:now_diff(os:timestamp(), InTimestamp) > Max;
|
||||
expires(#fusco_cookie{expires = Exp}, _) when Exp =/= undefined ->
|
||||
calendar:universal_time() > Exp;
|
||||
expires(_, _) ->
|
||||
false.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
split_scheme("http://" ++ HostPortPath) ->
|
||||
{http, HostPortPath};
|
||||
split_scheme("https://" ++ HostPortPath) ->
|
||||
{https, HostPortPath}.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
split_credentials(CredsHostPortPath) ->
|
||||
case string:tokens(CredsHostPortPath, "@") of
|
||||
[HostPortPath] ->
|
||||
{"", "", HostPortPath};
|
||||
[Creds, HostPortPath] ->
|
||||
% RFC1738 (section 3.1) says:
|
||||
% "The user name (and password), if present, are followed by a
|
||||
% commercial at-sign "@". Within the user and password field, any ":",
|
||||
% "@", or "/" must be encoded."
|
||||
% The mentioned encoding is the "percent" encoding.
|
||||
case string:tokens(Creds, ":") of
|
||||
[User] ->
|
||||
% RFC1738 says ":password" is optional
|
||||
{http_uri:decode(User), "", HostPortPath};
|
||||
[User, Passwd] ->
|
||||
{http_uri:decode(User), http_uri:decode(Passwd), HostPortPath}
|
||||
end
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec split_host(string(), string()) -> {string(), string()}.
|
||||
split_host("[" ++ Rest, []) ->
|
||||
% IPv6 address literals are enclosed by square brackets (RFC2732)
|
||||
case string:str(Rest, "]") of
|
||||
0 ->
|
||||
split_host(Rest, "[");
|
||||
N ->
|
||||
{IPv6Address, "]" ++ PortPath0} = lists:split(N - 1, Rest),
|
||||
case PortPath0 of
|
||||
":" ++ PortPath ->
|
||||
{IPv6Address, PortPath};
|
||||
_ ->
|
||||
{IPv6Address, PortPath0}
|
||||
end
|
||||
end;
|
||||
split_host([$: | PortPath], Host) ->
|
||||
{lists:reverse(Host), PortPath};
|
||||
split_host([$/ | _] = PortPath, Host) ->
|
||||
{lists:reverse(Host), PortPath};
|
||||
split_host([$? | _] = Query, Host) ->
|
||||
%% The query string follows the hostname, without a slash. The
|
||||
%% path is empty, but for HTTP an empty path is equivalent to "/"
|
||||
%% (RFC 3986, section 6.2.3), so let's add the slash ourselves.
|
||||
{lists:reverse(Host), "/" ++ Query};
|
||||
split_host([H | T], Host) ->
|
||||
split_host(T, [H | Host]);
|
||||
split_host([], Host) ->
|
||||
{lists:reverse(Host), []}.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
split_port(http, [$/ | _] = Path, []) ->
|
||||
{80, Path};
|
||||
split_port(https, [$/ | _] = Path, []) ->
|
||||
{443, Path};
|
||||
split_port(http, [], []) ->
|
||||
{80, "/"};
|
||||
split_port(https, [], []) ->
|
||||
{443, "/"};
|
||||
split_port(_, [], Port) ->
|
||||
{list_to_integer(lists:reverse(Port)), "/"};
|
||||
split_port(_,[$/ | _] = Path, Port) ->
|
||||
{list_to_integer(lists:reverse(Port)), Path};
|
||||
split_port(Scheme, [P | T], Port) ->
|
||||
split_port(Scheme, T, [P | Port]).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec add_mandatory_hdrs(string(), headers(), host(),
|
||||
iolist(), {boolean(), [#fusco_cookie{}]}) -> {iodata(), iodata()}.
|
||||
add_mandatory_hdrs(_Path, Hdrs, Host, Body, {_, []}) ->
|
||||
add_headers(Hdrs, Body, Host, undefined, []);
|
||||
add_mandatory_hdrs(_Path, Hdrs, Host, Body, {false, _}) ->
|
||||
add_headers(Hdrs, Body, Host, undefined, []);
|
||||
add_mandatory_hdrs(Path, Hdrs, Host, Body, {true, Cookies}) ->
|
||||
Result = {ContentHdrs, ConHdr} =
|
||||
add_headers(Hdrs, Body, Host, undefined, []),
|
||||
|
||||
%% http://tools.ietf.org/search/rfc6265#section-4.1.2.4
|
||||
%% only include cookies if the cookie path is a prefix of the request path
|
||||
%% TODO optimize cookie handling
|
||||
case lists:filter(
|
||||
fun(#fusco_cookie{path_tokens = undefined}) ->
|
||||
true;
|
||||
(#fusco_cookie{path_tokens = CookiePath}) ->
|
||||
SubPath = binary:split(Path, <<"/">>, [global]),
|
||||
is_prefix(CookiePath, SubPath)
|
||||
end, Cookies)
|
||||
of
|
||||
[] ->
|
||||
Result;
|
||||
IncludeCookies ->
|
||||
{add_cookie_headers(ContentHdrs, IncludeCookies), ConHdr}
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
%% http://tools.ietf.org/search/rfc6265#section-4.2.1
|
||||
add_cookie_headers(Hdrs, Cookies) ->
|
||||
[[<<"Cookie: ">>, make_cookie_string(Cookies, []), ?HTTP_LINE_END]
|
||||
| Hdrs].
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
make_cookie_string([], Acc) ->
|
||||
Acc;
|
||||
make_cookie_string([Cookie | Rest], []) ->
|
||||
make_cookie_string(Rest, cookie_string(Cookie));
|
||||
make_cookie_string([Cookie | Rest], Acc) ->
|
||||
make_cookie_string(Rest, [cookie_string(Cookie), "; " | Acc]).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%%------------------------------------------------------------------------------
|
||||
cookie_string(#fusco_cookie{name = Name, value = Value}) ->
|
||||
[Name, <<"=">>, Value].
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% Host header: http://tools.ietf.org/html/rfc2616#section-14.23
|
||||
%%------------------------------------------------------------------------------
|
||||
add_headers([{H, V} | T], undefined, undefined, Connection, Acc)
|
||||
when Connection =/= undefined ->
|
||||
add_headers(T, undefined, undefined, Connection,
|
||||
[[H, <<": ">>, V, ?HTTP_LINE_END] | Acc]);
|
||||
add_headers([{H, V} | T], Body, Host, Connection, Acc) ->
|
||||
case bin_to_lower(H) of
|
||||
<<"connection">> ->
|
||||
add_headers(T, Body, Host, V,
|
||||
[[H, <<": ">>, V, ?HTTP_LINE_END] | Acc]);
|
||||
<<"host">> ->
|
||||
add_headers(T, Body, undefined, Connection,
|
||||
[[H, <<": ">>, V, ?HTTP_LINE_END] | Acc]);
|
||||
<<"content-length">> ->
|
||||
add_headers(T, undefined, Host, Connection,
|
||||
[[H, <<": ">>, V, ?HTTP_LINE_END] | Acc]);
|
||||
_ ->
|
||||
add_headers(T, Body, Host, Connection,
|
||||
[[H, <<": ">>, V, ?HTTP_LINE_END] | Acc])
|
||||
end;
|
||||
add_headers([], undefined, Host, Connection, Headers) ->
|
||||
case Host of
|
||||
undefined ->
|
||||
{Headers, Connection};
|
||||
_ ->
|
||||
{[[<<"Host: ">>, Host, ?HTTP_LINE_END] | Headers], Connection}
|
||||
end;
|
||||
add_headers([], Body, Host, Connection, Headers) ->
|
||||
ContentLength = integer_to_list(iolist_size(Body)),
|
||||
case ContentLength > 0 of
|
||||
true ->
|
||||
add_headers([], undefined, Host, Connection,
|
||||
[[<<"Content-Length: ">>, ContentLength, ?HTTP_LINE_END]
|
||||
| Headers]);
|
||||
_ ->
|
||||
add_headers([], undefined, Host, Connection, Headers)
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @doc
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec host_header(host(), port_num()) -> any().
|
||||
host_header(Host, 80) -> maybe_ipv6_enclose(Host);
|
||||
% When proxying after an HTTP CONNECT session is established, squid doesn't
|
||||
% like the :443 suffix in the Host header.
|
||||
host_header(Host, 443) -> maybe_ipv6_enclose(Host);
|
||||
host_header(Host, Port) -> [maybe_ipv6_enclose(Host), $:, integer_to_list(Port)].
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec maybe_ipv6_enclose(host()) -> host().
|
||||
maybe_ipv6_enclose(Host) ->
|
||||
case inet_parse:address(Host) of
|
||||
{ok, {_, _, _, _, _, _, _, _}} ->
|
||||
% IPv6 address literals are enclosed by square brackets (RFC2732)
|
||||
[$[, Host, $]];
|
||||
_ ->
|
||||
Host
|
||||
end.
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @private
|
||||
%% @doc
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
char_to_lower($A) -> $a;
|
||||
char_to_lower($B) -> $b;
|
||||
char_to_lower($C) -> $c;
|
||||
char_to_lower($D) -> $d;
|
||||
char_to_lower($E) -> $e;
|
||||
char_to_lower($F) -> $f;
|
||||
char_to_lower($G) -> $g;
|
||||
char_to_lower($H) -> $h;
|
||||
char_to_lower($I) -> $i;
|
||||
char_to_lower($J) -> $j;
|
||||
char_to_lower($K) -> $k;
|
||||
char_to_lower($L) -> $l;
|
||||
char_to_lower($M) -> $m;
|
||||
char_to_lower($N) -> $n;
|
||||
char_to_lower($O) -> $o;
|
||||
char_to_lower($P) -> $p;
|
||||
char_to_lower($Q) -> $q;
|
||||
char_to_lower($R) -> $r;
|
||||
char_to_lower($S) -> $s;
|
||||
char_to_lower($T) -> $t;
|
||||
char_to_lower($U) -> $u;
|
||||
char_to_lower($V) -> $v;
|
||||
char_to_lower($W) -> $w;
|
||||
char_to_lower($X) -> $x;
|
||||
char_to_lower($Y) -> $y;
|
||||
char_to_lower($Z) -> $z;
|
||||
char_to_lower(Ch) -> Ch.
|
||||
|
||||
is_prefix([<<>>], _) ->
|
||||
true;
|
||||
is_prefix([H | T1], [H | T2]) ->
|
||||
is_prefix(T1, T2);
|
||||
is_prefix([], _) ->
|
||||
true;
|
||||
is_prefix(_, []) ->
|
||||
false;
|
||||
is_prefix(_, _) ->
|
||||
false.
|
||||
|
||||
|
|
@ -0,0 +1,567 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%%
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(fusco_protocol).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-include("fusco.hrl").
|
||||
|
||||
-define(SIZE(Data, Response), Response#response{size = Response#response.size + byte_size(Data)}).
|
||||
-define(RECEPTION(Data, Response), Response#response{size = byte_size(Data),
|
||||
in_timestamp = os:timestamp()}).
|
||||
-define(TOUT, 1000).
|
||||
%% Latency is here defined as the time from the start of packet transmission to the start of packet reception
|
||||
|
||||
%% API
|
||||
-export([recv/2, recv/3,
|
||||
decode_cookie/1]).
|
||||
|
||||
%% TEST
|
||||
-export([decode_header_value/5, decode_header_value/6,
|
||||
decode_header/3, decode_header/4]).
|
||||
|
||||
%% TODO handle partial downloads
|
||||
|
||||
recv(Socket, Ssl) ->
|
||||
recv(Socket, Ssl, infinity).
|
||||
|
||||
recv(Socket, Ssl, Timeout) ->
|
||||
case fusco_sock:recv(Socket, Ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_status_line(<< Data/binary >>,
|
||||
?RECEPTION(Data, #response{socket = Socket, ssl = Ssl}), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end.
|
||||
|
||||
decode_status_line(<<"HTTP/1.0\s",C1,C2,C3,$\s,Rest/bits>>, Response, Timeout) ->
|
||||
decode_reason_phrase(Rest, <<>>, Response#response{version = {1,0},
|
||||
status_code = <<C1,C2,C3>>}, Timeout);
|
||||
decode_status_line(<<"HTTP/1.1\s",C1,C2,C3,$\s,Rest/bits>>, Response, Timeout) ->
|
||||
decode_reason_phrase(Rest, <<>>, Response#response{version = {1,1},
|
||||
status_code = <<C1,C2,C3>>}, Timeout);
|
||||
decode_status_line(Bin, Response = #response{size = Size}, Timeout) when Size < 13 ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_status_line(<<Bin/binary, Data/binary>>, ?SIZE(Data, Response), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_status_line(_, _, _) ->
|
||||
{error, status_line}.
|
||||
|
||||
decode_reason_phrase(<<>>, Acc, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_reason_phrase(Data, Acc, ?SIZE(Data, Response), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_reason_phrase(<<$\r>>, Acc, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_reason_phrase(<<$\r, Data/binary>>, Acc, ?SIZE(Data, Response), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_reason_phrase(<<$\n, Rest/bits>>, Acc, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{reason = Acc}, Timeout);
|
||||
decode_reason_phrase(<<$\r,$\n, Rest/bits>>, Acc, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{reason = Acc}, Timeout);
|
||||
decode_reason_phrase(<<C, Rest/bits>>, Acc, Response, Timeout) ->
|
||||
decode_reason_phrase(Rest, <<Acc/binary, C>>, Response, Timeout).
|
||||
|
||||
decode_header(Data, Acc, Response) ->
|
||||
decode_header(Data, Acc, Response, infinity).
|
||||
|
||||
decode_header(<<>>, Acc, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_header(Data, Acc, ?SIZE(Data, Response), Timeout);
|
||||
{error, closed} ->
|
||||
case Acc of
|
||||
<<>> ->
|
||||
decode_body(<<>>, Response, Timeout);
|
||||
_ ->
|
||||
{error, closed}
|
||||
end;
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_header(<<$\r>>, Acc, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_header(<<$\r, Data/binary>>, Acc, ?SIZE(Data, Response), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_header(<<$\s, Rest/bits>>, Acc, Response, Timeout) ->
|
||||
decode_header(Rest, Acc, Response, Timeout);
|
||||
decode_header(<<$:, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header_value_ws(Rest, Header, Response, Timeout);
|
||||
decode_header(<<$\n, Rest/bits>>, <<>>, Response, Timeout) ->
|
||||
decode_body(Rest, Response, Timeout);
|
||||
decode_header(<<$\r, $\n, Rest/bits>>, <<>>, Response, Timeout) ->
|
||||
decode_body(Rest, Response, Timeout);
|
||||
decode_header(<<$\r, $\n, _Rest/bits>>, _, _Response, _Timeout) ->
|
||||
{error, header};
|
||||
decode_header(<<$A, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $a>>, Response, Timeout);
|
||||
decode_header(<<$B, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $b>>, Response, Timeout);
|
||||
decode_header(<<$C, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $c>>, Response, Timeout);
|
||||
decode_header(<<$D, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $d>>, Response, Timeout);
|
||||
decode_header(<<$E, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $e>>, Response, Timeout);
|
||||
decode_header(<<$F, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $f>>, Response, Timeout);
|
||||
decode_header(<<$G, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $g>>, Response, Timeout);
|
||||
decode_header(<<$H, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $h>>, Response, Timeout);
|
||||
decode_header(<<$I, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $i>>, Response, Timeout);
|
||||
decode_header(<<$J, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $j>>, Response, Timeout);
|
||||
decode_header(<<$K, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $k>>, Response, Timeout);
|
||||
decode_header(<<$L, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $l>>, Response, Timeout);
|
||||
decode_header(<<$M, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $m>>, Response, Timeout);
|
||||
decode_header(<<$N, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $n>>, Response, Timeout);
|
||||
decode_header(<<$O, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $o>>, Response, Timeout);
|
||||
decode_header(<<$P, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $p>>, Response, Timeout);
|
||||
decode_header(<<$Q, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $q>>, Response, Timeout);
|
||||
decode_header(<<$R, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $r>>, Response, Timeout);
|
||||
decode_header(<<$S, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $s>>, Response, Timeout);
|
||||
decode_header(<<$T, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $t>>, Response, Timeout);
|
||||
decode_header(<<$U, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $u>>, Response, Timeout);
|
||||
decode_header(<<$V, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $v>>, Response, Timeout);
|
||||
decode_header(<<$W, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $w>>, Response, Timeout);
|
||||
decode_header(<<$X, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $x>>, Response, Timeout);
|
||||
decode_header(<<$Y, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $y>>, Response, Timeout);
|
||||
decode_header(<<$Z, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, $z>>, Response, Timeout);
|
||||
decode_header(<<C, Rest/bits>>, Header, Response, Timeout) ->
|
||||
decode_header(Rest, <<Header/binary, C>>, Response, Timeout).
|
||||
|
||||
decode_header_value_ws(<<$\s, Rest/bits>>, H, S, Timeout) ->
|
||||
decode_header_value_ws(Rest, H, S, Timeout);
|
||||
decode_header_value_ws(<<$\t, Rest/bits>>, H, S, Timeout) ->
|
||||
decode_header_value_ws(Rest, H, S, Timeout);
|
||||
decode_header_value_ws(Rest, <<"connection">> = H, S, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<>>, <<>>, S, Timeout);
|
||||
decode_header_value_ws(Rest, <<"transfer-encoding">> = H, S, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<>>, <<>>, S, Timeout);
|
||||
decode_header_value_ws(Rest, H, S, Timeout) ->
|
||||
decode_header_value(Rest, H, <<>>, <<>>, S, Timeout).
|
||||
|
||||
decode_header_value(Data, H, V, T, Response) ->
|
||||
decode_header_value(Data, H, V, T, Response, infinity).
|
||||
|
||||
decode_header_value(<<>>, H, V, T, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_header_value(Data, H, V, T, ?SIZE(Data, Response), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_header_value(<<$\r>>, H, V, T, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_header_value(<<$\r, Data/binary>>, H, V, T, ?SIZE(Data, Response), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_header_value(<<$\n, Rest/bits>>, <<"content-length">> = H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{headers = [{H, V} | Response#response.headers],
|
||||
content_length = binary_to_integer(V)}, Timeout);
|
||||
decode_header_value(<<$\n, Rest/bits>>, <<"set-cookie">> = H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{cookies = [decode_cookie(V)
|
||||
| Response#response.cookies],
|
||||
headers = [{H, V} | Response#response.headers]}, Timeout);
|
||||
decode_header_value(<<$\n, Rest/bits>>, H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{headers = [{H, V} | Response#response.headers]}, Timeout);
|
||||
decode_header_value(<<$\r, $\n, Rest/bits>>, <<"set-cookie">> = H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{cookies = [decode_cookie(V)
|
||||
| Response#response.cookies],
|
||||
headers = [{H, V} | Response#response.headers]}, Timeout);
|
||||
decode_header_value(<<$\r,$\n, Rest/bits>>, <<"content-length">> = H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{headers = [{H, V} | Response#response.headers],
|
||||
content_length = binary_to_integer(V)}, Timeout);
|
||||
decode_header_value(<<$\r, $\n, Rest/bits>>, H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{headers = [{H, V} | Response#response.headers]}, Timeout);
|
||||
decode_header_value(<<$\s, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value(Rest, H, V, <<T/binary, $\s>>, Response, Timeout);
|
||||
decode_header_value(<<$\t, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value(Rest, H, V, <<T/binary, $\t>>, Response, Timeout);
|
||||
decode_header_value(<<C, Rest/bits>>, H, V, <<>>, Response, Timeout) ->
|
||||
decode_header_value(Rest, H, <<V/binary, C>>, <<>>, Response, Timeout);
|
||||
decode_header_value(<<C, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value(Rest, H, <<V/binary, T/binary, C>>, <<>>, Response, Timeout).
|
||||
|
||||
decode_header_value_lc(<<>>, H, V, T, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_header_value_lc(Data, H, V, T, ?SIZE(Data, Response), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_header_value_lc(<<$\r>>, H, V, T, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_header_value_lc(<<$\r, Data/binary>>, H, V, T, ?SIZE(Data, Response), Timeout);
|
||||
{error, Reason} ->
|
||||
{error, Reason}
|
||||
end;
|
||||
decode_header_value_lc(<<$\n, Rest/bits>>, <<"transfer-encoding">> = H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{headers = [{H, V} | Response#response.headers],
|
||||
transfer_encoding = V}, Timeout);
|
||||
decode_header_value_lc(<<$\n, Rest/bits>>, H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{headers = [{H, V} | Response#response.headers],
|
||||
connection = V}, Timeout);
|
||||
decode_header_value_lc(<<$\r, $\n, Rest/bits>>, <<"transfer-encoding">> = H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{headers = [{H, V} | Response#response.headers],
|
||||
transfer_encoding = V}, Timeout);
|
||||
decode_header_value_lc(<<$\r, $\n, Rest/bits>>, H, V, _T, Response, Timeout) ->
|
||||
decode_header(Rest, <<>>, Response#response{headers = [{H, V} | Response#response.headers],
|
||||
connection = V}, Timeout);
|
||||
decode_header_value_lc(<<$\s, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, V, <<T/binary, $\s>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$\t, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, V, <<T/binary, $\t>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$A, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $a>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$B, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $b>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$C, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $c>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$D, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $d>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$E, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $e>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$F, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $f>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$G, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $g>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$H, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $h>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$I, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $i>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$J, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $j>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$K, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $k>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$L, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $l>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$M, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $m>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$N, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $n>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$O, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $o>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$P, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $p>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$Q, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $q>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$R, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $r>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$S, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $s>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$T, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $t>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$U, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $u>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$V, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $v>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$W, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $w>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$X, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $x>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$Y, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $y>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<$Z, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, $z>>, <<>>, Response, Timeout);
|
||||
decode_header_value_lc(<<C, Rest/bits>>, H, V, T, Response, Timeout) ->
|
||||
decode_header_value_lc(Rest, H, <<V/binary, T/binary, C>>, <<>>, Response, Timeout).
|
||||
|
||||
%% RFC 6265
|
||||
%% TODO decode cookie values, this only accepts 'a=b'
|
||||
decode_cookie(Cookie) ->
|
||||
decode_cookie_name(Cookie, <<>>).
|
||||
|
||||
decode_cookie_name(<<$\s, Rest/bits>>, N) ->
|
||||
decode_cookie_name(Rest, N);
|
||||
decode_cookie_name(<<$\t, Rest/bits>>, N) ->
|
||||
decode_cookie_name(Rest, N);
|
||||
decode_cookie_name(<<$=, Rest/bits>>, N) ->
|
||||
decode_cookie_value(Rest, N, <<>>);
|
||||
decode_cookie_name(<<C, Rest/bits>>, N) ->
|
||||
decode_cookie_name(Rest, <<N/binary, C>>).
|
||||
|
||||
decode_cookie_value(<<$\s, Rest/bits>>, N, V) ->
|
||||
decode_cookie_value(Rest, N, V);
|
||||
decode_cookie_value(<<$\t, Rest/bits>>, N, V) ->
|
||||
decode_cookie_value(Rest, N, V);
|
||||
decode_cookie_value(<<$;, Rest/bits>>, N, V) ->
|
||||
decode_cookie_av_ws(Rest, #fusco_cookie{name = N, value = V});
|
||||
decode_cookie_value(<<C, Rest/bits>>, N, V) ->
|
||||
decode_cookie_value(Rest, N, <<V/binary, C>>);
|
||||
decode_cookie_value(<<>>, N, V) ->
|
||||
#fusco_cookie{name = N, value = V}.
|
||||
|
||||
decode_cookie_av_ws(<<$\s, Rest/bits>>, C) ->
|
||||
decode_cookie_av_ws(Rest, C);
|
||||
decode_cookie_av_ws(<<$\t, Rest/bits>>, C) ->
|
||||
decode_cookie_av_ws(Rest, C);
|
||||
%% We are only interested on Expires, Max-Age, Path, Domain
|
||||
decode_cookie_av_ws(<<$e, Rest/bits>>, C) ->
|
||||
decode_cookie_av(Rest, C, <<$e>>);
|
||||
decode_cookie_av_ws(<<$E, Rest/bits>>, C) ->
|
||||
decode_cookie_av(Rest, C, <<$e>>);
|
||||
decode_cookie_av_ws(<<$m, Rest/bits>>, C) ->
|
||||
decode_cookie_av(Rest, C, <<$m>>);
|
||||
decode_cookie_av_ws(<<$M, Rest/bits>>, C) ->
|
||||
decode_cookie_av(Rest, C, <<$m>>);
|
||||
decode_cookie_av_ws(<<$p, Rest/bits>>, C) ->
|
||||
decode_cookie_av(Rest, C, <<$p>>);
|
||||
decode_cookie_av_ws(<<$P, Rest/bits>>, C) ->
|
||||
decode_cookie_av(Rest, C, <<$p>>);
|
||||
decode_cookie_av_ws(<<$d, Rest/bits>>, C) ->
|
||||
decode_cookie_av(Rest, C, <<$d>>);
|
||||
decode_cookie_av_ws(<<$D, Rest/bits>>, C) ->
|
||||
decode_cookie_av(Rest, C, <<$d>>);
|
||||
decode_cookie_av_ws(Rest, C) ->
|
||||
ignore_cookie_av(Rest, C).
|
||||
|
||||
ignore_cookie_av(<<$;, Rest/bits>>, Co) ->
|
||||
decode_cookie_av_ws(Rest, Co);
|
||||
ignore_cookie_av(<<_, Rest/bits>>, Co) ->
|
||||
ignore_cookie_av(Rest, Co);
|
||||
ignore_cookie_av(<<>>, Co) ->
|
||||
Co.
|
||||
|
||||
%% Match only uppercase chars on Expires, Max-Age, Path, Domain
|
||||
decode_cookie_av(<<$=, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av_value(Rest, Co, AV, <<>>);
|
||||
decode_cookie_av(<<$D, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $d>>);
|
||||
decode_cookie_av(<<$O, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $o>>);
|
||||
decode_cookie_av(<<$N, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $n>>);
|
||||
decode_cookie_av(<<$E, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $e>>);
|
||||
decode_cookie_av(<<$X, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $x>>);
|
||||
decode_cookie_av(<<$P, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $p>>);
|
||||
decode_cookie_av(<<$I, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $i>>);
|
||||
decode_cookie_av(<<$R, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $r>>);
|
||||
decode_cookie_av(<<$S, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $s>>);
|
||||
decode_cookie_av(<<$M, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $m>>);
|
||||
decode_cookie_av(<<$A, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $a>>);
|
||||
decode_cookie_av(<<$G, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $g>>);
|
||||
decode_cookie_av(<<$T, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $t>>);
|
||||
decode_cookie_av(<<$H, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, $h>>);
|
||||
decode_cookie_av(<<$;, Rest/bits>>, Co, _AV) ->
|
||||
decode_cookie_av_ws(Rest, Co);
|
||||
decode_cookie_av(<<C, Rest/bits>>, Co, AV) ->
|
||||
decode_cookie_av(Rest, Co, <<AV/binary, C>>);
|
||||
decode_cookie_av(<<>>, Co, _AV) ->
|
||||
ignore_cookie_av(<<>>, Co).
|
||||
|
||||
decode_cookie_av_value(<<>>, Co, <<"path">>, Value) ->
|
||||
Co#fusco_cookie{path_tokens = binary:split(Value, <<"/">>, [global]),
|
||||
path = Value};
|
||||
decode_cookie_av_value(<<>>, Co, <<"max-age">>, Value) ->
|
||||
Co#fusco_cookie{max_age = max_age(Value)};
|
||||
decode_cookie_av_value(<<>>, Co, <<"expires">>, Value) ->
|
||||
Co#fusco_cookie{expires = expires(Value)};
|
||||
decode_cookie_av_value(<<>>, Co, <<"domain">>, Value) ->
|
||||
Co#fusco_cookie{domain = Value};
|
||||
decode_cookie_av_value(<<$;, Rest/bits>>, Co, <<"path">>, Value) ->
|
||||
Path = binary:split(Value, <<"/">>, [global]),
|
||||
decode_cookie_av_ws(Rest, Co#fusco_cookie{path_tokens = Path,
|
||||
path = Value});
|
||||
decode_cookie_av_value(<<$;, Rest/bits>>, Co, <<"max-age">>, Value) ->
|
||||
decode_cookie_av_ws(Rest, Co#fusco_cookie{
|
||||
max_age = max_age(Value)});
|
||||
decode_cookie_av_value(<<$;, Rest/bits>>, Co, <<"expires">>, Value) ->
|
||||
%% TODO parse expires
|
||||
decode_cookie_av_ws(Rest, Co#fusco_cookie{expires = expires(Value)});
|
||||
decode_cookie_av_value(<<$;, Rest/bits>>, Co, <<"domain">>, Value) ->
|
||||
decode_cookie_av_ws(Rest, Co#fusco_cookie{domain = Value});
|
||||
decode_cookie_av_value(<<$;, Rest/bits>>, Co, _, _) ->
|
||||
decode_cookie_av_ws(Rest, Co);
|
||||
decode_cookie_av_value(<<C, Rest/bits>>, Co, AV, Value) ->
|
||||
decode_cookie_av_value(Rest, Co, AV, <<Value/binary, C>>).
|
||||
|
||||
|
||||
decode_body(<<>>, Response = #response{status_code = <<$1, _, _>>,
|
||||
transfer_encoding = TE}, _Timeout)
|
||||
when TE =/= <<"chunked">> ->
|
||||
return(<<>>, Response);
|
||||
decode_body(<<$\r, $\n, Rest/bits>>, Response, Timeout) ->
|
||||
decode_body(Rest, Response, Timeout);
|
||||
decode_body(Rest, Response = #response{status_code = <<$1, _, _>>,
|
||||
transfer_encoding = TE}, Timeout)
|
||||
when TE =/= <<"chunked">> ->
|
||||
decode_status_line(Rest, #response{socket = Response#response.socket,
|
||||
ssl = Response#response.ssl,
|
||||
in_timestamp = Response#response.in_timestamp}, Timeout);
|
||||
decode_body(Rest, Response = #response{transfer_encoding = <<"chunked">>}, Timeout) ->
|
||||
decode_chunked_body(Rest, <<>>, <<>>, Response, Timeout);
|
||||
decode_body(Rest, Response, Timeout) ->
|
||||
case byte_size(Rest) >= Response#response.content_length of
|
||||
true ->
|
||||
return(Rest, Response);
|
||||
false ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_body(<<Rest/binary, Data/binary>>, ?SIZE(Data, Response), Timeout);
|
||||
_ ->
|
||||
%% NOTE: Return what we have so far
|
||||
return(Rest, Response)
|
||||
end
|
||||
end.
|
||||
|
||||
download_chunked_body(Rest, Acc, Size, Response, Timeout) ->
|
||||
case fusco_sock:recv(Response#response.socket, Response#response.ssl, Timeout) of
|
||||
{ok, Data} ->
|
||||
decode_chunked_body(<<Rest/bits, Data/bits>>, Acc, Size,
|
||||
?SIZE(Data, Response), Timeout);
|
||||
_ ->
|
||||
return(Acc, Response)
|
||||
end.
|
||||
|
||||
decode_chunked_body(<<$0,$\r,$\n,$\r,$\n>>, Acc, _, Response, _Timeout) ->
|
||||
return(Acc, Response);
|
||||
decode_chunked_body(<<$0, Rest/bits>> = R, Acc, Size, Response, Timeout)
|
||||
when is_binary(Size), byte_size(Rest) < 4 ->
|
||||
download_chunked_body(R, Acc, Size, Response, Timeout);
|
||||
decode_chunked_body(<<$\r>> = R, Acc, Size, Response, Timeout) when is_binary(Size) ->
|
||||
download_chunked_body(R, Acc, Size, Response, Timeout);
|
||||
decode_chunked_body(<<$\r,$\n, Rest/bits>>, Acc, <<>>, Response, Timeout) ->
|
||||
decode_chunked_body(Rest, Acc, <<>>, Response, Timeout);
|
||||
decode_chunked_body(<<$\r,$\n, Rest/bits>>, Acc, Size, Response, Timeout) when is_binary(Size) ->
|
||||
IntSize = erlang:binary_to_integer(Size, 16),
|
||||
decode_chunked_body(Rest, Acc, IntSize, Response, Timeout);
|
||||
decode_chunked_body(<<C, Rest/bits>>, Acc, Size, Response, Timeout) when is_binary(Size) ->
|
||||
decode_chunked_body(Rest, Acc, <<Size/bits, C>>, Response, Timeout);
|
||||
decode_chunked_body(<<>> = R, Acc, Size, Response, Timeout) when is_binary(Size) ->
|
||||
download_chunked_body(R, Acc, Size, Response, Timeout);
|
||||
decode_chunked_body(Rest, Acc, Size, Response, Timeout) when is_integer(Size) ->
|
||||
case byte_size(Rest) of
|
||||
S when S == Size ->
|
||||
decode_chunked_body(<<>>, <<Acc/bits, Rest/bits>>, <<>>, Response, Timeout);
|
||||
S when S < Size ->
|
||||
download_chunked_body(Rest, Acc, Size, Response, Timeout);
|
||||
S when S > Size ->
|
||||
Current = binary:part(Rest, 0, Size),
|
||||
Next = binary:part(Rest, Size, S - Size),
|
||||
decode_chunked_body(Next, <<Acc/bits, Current/bits>>, <<>>, Response, Timeout)
|
||||
end.
|
||||
|
||||
return(Body, Response) ->
|
||||
Response#response{body = Body}.
|
||||
|
||||
max_age(Value) ->
|
||||
binary_to_integer(Value) * 1000000.
|
||||
|
||||
%% http://tools.ietf.org/html/rfc2616#section-3.3.1
|
||||
%% Supports some non-standard datetime (Tomcat) Tue, 06-Nov-1994 08:49:37 GMT
|
||||
expires(<<_,_,_,$,,$\s,D1,D2,$\s,M1,M2,M3,$\s,Y1,Y2,Y3,Y4,$\s,Rest/bits>>) ->
|
||||
expires(Rest, {list_to_integer([Y1,Y2,Y3,Y4]),month(<<M1,M2,M3>>),list_to_integer([D1,D2])});
|
||||
expires(<<_,_,_,$\s,Mo1,Mo2,Mo3,$\s,D1,D2,$\s,H1,H2,$:,M1,M2,$:,S1,S2,$\s,Y1,Y2,Y3,Y4,_Rest/bits>>) ->
|
||||
{{list_to_integer([Y1,Y2,Y3,Y4]),month(<<Mo1,Mo2,Mo3>>),list_to_integer([D1,D2])},
|
||||
{list_to_integer([H1,H2]), list_to_integer([M1,M2]), list_to_integer([S1,S2])}};
|
||||
expires(<<_,_,_,$,,$\s,Rest/bits>>) ->
|
||||
expires(Rest);
|
||||
expires(<<"Monday",$,,$\s,Rest/bits>>) ->
|
||||
expires(Rest);
|
||||
expires(<<"Tuesday",$,,$\s,Rest/bits>>) ->
|
||||
expires(Rest);
|
||||
expires(<<"Wednesday",$,,$\s,Rest/bits>>) ->
|
||||
expires(Rest);
|
||||
expires(<<"Thursday",$,,$\s,Rest/bits>>) ->
|
||||
expires(Rest);
|
||||
expires(<<"Friday",$,,$\s,Rest/bits>>) ->
|
||||
expires(Rest);
|
||||
expires(<<"Saturday",$,,$\s,Rest/bits>>) ->
|
||||
expires(Rest);
|
||||
expires(<<"Sunday",$,,$\s,Rest/bits>>) ->
|
||||
expires(Rest);
|
||||
expires(<<D1,D2,$\-,M1,M2,M3,$\-,Y1,Y2,Y3,Y4,$\s,Rest/bits>>) ->
|
||||
expires(Rest, {list_to_integer([Y1,Y2,Y3,Y4]),month(<<M1,M2,M3>>),list_to_integer([D1,D2])});
|
||||
expires(<<D1,D2,$\-,M1,M2,M3,$\-,Y3,Y4,$\s,Rest/bits>>) ->
|
||||
%% http://tools.ietf.org/html/rfc2616#section-19.3
|
||||
%% HTTP/1.1 clients and caches SHOULD assume that an RFC-850 date
|
||||
%% which appears to be more than 50 years in the future is in fact
|
||||
%% in the past (this helps solve the "year 2000" problem).
|
||||
expires(Rest, {to_year([Y3, Y4]),month(<<M1,M2,M3>>),list_to_integer([D1,D2])}).
|
||||
|
||||
to_year(List) ->
|
||||
Int = list_to_integer(List),
|
||||
{Y, _, _} = date(),
|
||||
case (2000 + Int - Y) > 50 of
|
||||
true ->
|
||||
1900 + Int;
|
||||
false ->
|
||||
2000 + Int
|
||||
end.
|
||||
|
||||
expires(<<H1,H2,$:,M1,M2,$:,S1,S2,_Rest/bits>>, Date) ->
|
||||
{Date, {list_to_integer([H1,H2]), list_to_integer([M1,M2]), list_to_integer([S1,S2])}}.
|
||||
|
||||
month(<<$J,$a,$n>>) ->
|
||||
1;
|
||||
month(<<$F,$e,$b>>) ->
|
||||
2;
|
||||
month(<<$M,$a,$r>>) ->
|
||||
3;
|
||||
month(<<$A,$p,$r>>) ->
|
||||
4;
|
||||
month(<<$M,$a,$y>>) ->
|
||||
5;
|
||||
month(<<$J,$u,$n>>) ->
|
||||
6;
|
||||
month(<<$J,$u,$l>>) ->
|
||||
7;
|
||||
month(<<$A,$u,$g>>) ->
|
||||
8;
|
||||
month(<<$S,$e,$p>>) ->
|
||||
9;
|
||||
month(<<$O,$c,$t>>) ->
|
||||
10;
|
||||
month(<<$N,$o,$v>>) ->
|
||||
11;
|
||||
month(<<$D,$e,$c>>) ->
|
||||
12.
|
||||
|
|
@ -0,0 +1,123 @@
|
|||
%%%-----------------------------------------------------------------------------
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Oscar Hellström <oscar@hellstrom.st>
|
||||
%%% @author Diana Parra Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc This module implements wrappers for socket operations.
|
||||
%%%
|
||||
%%% Makes it possible to have the same interface to ssl and tcp sockets.
|
||||
%%% @end
|
||||
%%%-----------------------------------------------------------------------------
|
||||
-module(fusco_sock).
|
||||
|
||||
-export([connect/5,
|
||||
recv/2,
|
||||
recv/3,
|
||||
send/3,
|
||||
close/2,
|
||||
setopts/3]).
|
||||
|
||||
-include("fusco_types.hrl").
|
||||
|
||||
%%==============================================================================
|
||||
%% Exported functions
|
||||
%%==============================================================================
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec (Host, Port, Options, Timeout, SslFlag) -> {ok, Socket} | {error, Reason}
|
||||
%% Host = string() | ip_address()
|
||||
%% Port = integer()
|
||||
%% Options = [{atom(), term()} | atom()]
|
||||
%% Timeout = infinity | integer()
|
||||
%% SslFlag = boolean()
|
||||
%% Socket = socket()
|
||||
%% Reason = atom()
|
||||
%% @doc
|
||||
%% Connects to `Host' and `Port'.
|
||||
%% Will use the `ssl' module if `SslFlag' is `true' and gen_tcp otherwise.
|
||||
%% `Options' are the normal `gen_tcp' or `ssl' Options.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec connect(host(), integer(), socket_options(), timeout(), boolean()) ->
|
||||
{ok, socket()} | {error, atom()}.
|
||||
connect(Host, Port, Options, Timeout, true) ->
|
||||
ssl:connect(Host, Port, Options, Timeout);
|
||||
connect(Host, Port, Options, Timeout, false) ->
|
||||
gen_tcp:connect(Host, Port, Options, Timeout).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec (Socket, SslFlag) -> {ok, Data} | {error, Reason}
|
||||
%% Socket = socket()
|
||||
%% Length = integer()
|
||||
%% SslFlag = boolean()
|
||||
%% Data = term()
|
||||
%% Reason = atom()
|
||||
%% @doc
|
||||
%% Reads available bytes from `Socket'.
|
||||
%% Will block untill data is available on the socket and return the first
|
||||
%% packet.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec recv(socket(), boolean()) ->
|
||||
{ok, any()} | {error, atom()} | {error, {http_error, string()}}.
|
||||
recv(Socket, true) ->
|
||||
ssl:recv(Socket, 0);
|
||||
recv(Socket, false) ->
|
||||
prim_inet:recv(Socket, 0).
|
||||
|
||||
-spec recv(socket(), boolean(), timeout()) ->
|
||||
{ok, any()} | {error, atom()} | {error, {http_error, string()}}.
|
||||
recv(Socket, true, Timeout) ->
|
||||
ssl:recv(Socket, 0, Timeout);
|
||||
recv(Socket, false, Timeout) ->
|
||||
prim_inet:recv(Socket, 0, Timeout).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec (Socket, Data, SslFlag) -> ok | {error, Reason}
|
||||
%% Socket = socket()
|
||||
%% Data = iolist()
|
||||
%% SslFlag = boolean()
|
||||
%% Reason = atom()
|
||||
%% @doc
|
||||
%% Sends data on a socket.
|
||||
%% Will use the `ssl' module if `SslFlag' is set to `true', otherwise the
|
||||
%% gen_tcp module.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec send(socket(), iolist() | binary(), boolean()) -> ok | {error, atom()}.
|
||||
send(Socket, Request, true) ->
|
||||
ssl:send(Socket, Request);
|
||||
send(Socket, Request, false) ->
|
||||
prim_inet:send(Socket, Request, []).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec (Socket, SslFlag) -> ok | {error, Reason}
|
||||
%% Socket = socket()
|
||||
%% SslFlag = boolean()
|
||||
%% Reason = atom()
|
||||
%% @doc
|
||||
%% Closes a socket.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec close(socket(), boolean()) -> ok | {error, atom()}.
|
||||
close(Socket, true) ->
|
||||
ssl:close(Socket);
|
||||
close(Socket, false) ->
|
||||
gen_tcp:close(Socket).
|
||||
|
||||
%%------------------------------------------------------------------------------
|
||||
%% @spec (Socket, Opts, SslFlag) -> ok | {error, Reason}
|
||||
%% Socket = socket()
|
||||
%% Opts = list()
|
||||
%% SslFlag = boolean()
|
||||
%% Reason = atom()
|
||||
%% @doc
|
||||
%% Sets options for a socket.
|
||||
%% Will use the `ssl' module if `SslFlag' is set to `true', otherwise the
|
||||
%% inets module.
|
||||
%% @end
|
||||
%%------------------------------------------------------------------------------
|
||||
-spec setopts(socket(), list(), boolean()) -> ok | {error, atom()}.
|
||||
setopts(Socket, Opts, true) ->
|
||||
ssl:setopts(Socket, Opts);
|
||||
setopts(Socket, Opts, false) ->
|
||||
inet:setopts(Socket, Opts).
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
-----BEGIN CERTIFICATE-----
|
||||
MIICqzCCAhQCCQCDYWGxYNaErjANBgkqhkiG9w0BAQUFADCBmTELMAkGA1UEBhMC
|
||||
VUsxDzANBgNVBAgTBkVybGFuZzEPMA0GA1UEBxMGTG9uZG9uMSwwKgYDVQQKEyNF
|
||||
cmxhbmcgVHJhaW5pbmcgYW5kIENvbnN1bHRpbmcgTHRkLjEPMA0GA1UEAxMGbGh0
|
||||
dHBjMSkwJwYJKoZIhvcNAQkBFhpjb2RlQGVybGFuZy1jb25zdWx0aW5nLmNvbTAe
|
||||
Fw0wOTA2MDYxNjA2MThaFw0xMDA2MDYxNjA2MThaMIGZMQswCQYDVQQGEwJVSzEP
|
||||
MA0GA1UECBMGRXJsYW5nMQ8wDQYDVQQHEwZMb25kb24xLDAqBgNVBAoTI0VybGFu
|
||||
ZyBUcmFpbmluZyBhbmQgQ29uc3VsdGluZyBMdGQuMQ8wDQYDVQQDEwZsaHR0cGMx
|
||||
KTAnBgkqhkiG9w0BCQEWGmNvZGVAZXJsYW5nLWNvbnN1bHRpbmcuY29tMIGfMA0G
|
||||
CSqGSIb3DQEBAQUAA4GNADCBiQKBgQC6YrA5HIBj817qplKlRaU3dkCnnZtKS666
|
||||
lRbqsdj3Fug7ezANmUrUZIGMTDOAwYg3E2JPAL1VOiPmi/ENlanLTyOp2SkqYLfR
|
||||
59Z5wr1nE/iAC+es7WT2OPjXG7MIBvnM7FNpHY17F4MM0FWWm+LJyJRucUZHL964
|
||||
nw0c2xZ3fwIDAQABMA0GCSqGSIb3DQEBBQUAA4GBAHRPJK72okG7u//YgJ1zIHzi
|
||||
P8xtoUqwRikNNK1Zf1//xrgMFdsX4M7ZrX+SJ5ArXXpvy8iUbx81m9w+tuEyqdnl
|
||||
VbBherAqLi2XmwJFu2n6TIfJB2eUjZg95lUbIJsNuiqL05/LNthFdkVAvyi8nTC4
|
||||
KAqPDQhDdvpmaBZDKE1L
|
||||
-----END CERTIFICATE-----
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
%%% ----------------------------------------------------------------------------
|
||||
%%% @copyright (C) 2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Parra Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc Fusco Client Pool tests
|
||||
%%% @end
|
||||
%%%-----------------------------------------------------------------------------
|
||||
-module(fusco_cp_tests).
|
||||
|
||||
-include_lib("eunit/include/eunit.hrl").
|
||||
|
||||
-define(POOL, fusco_pool).
|
||||
|
||||
client_pool_test_() ->
|
||||
{foreach,
|
||||
fun() ->
|
||||
{ok, Pid} = fusco_cp:start({"127.0.0.1", 5050, false}, [], 3),
|
||||
erlang:register(?POOL, Pid),
|
||||
Pid
|
||||
end,
|
||||
fun(Pid) ->
|
||||
fusco_cp:stop(Pid)
|
||||
end,
|
||||
[
|
||||
{timeout, 60000, {"Get client", fun get_client/0}},
|
||||
{"Free client", fun free_client/0},
|
||||
{"Unblock client", fun unblock_client/0}
|
||||
]
|
||||
}.
|
||||
|
||||
get_client() ->
|
||||
?assertEqual(true, is_pid(fusco_cp:get_client(?POOL))),
|
||||
?assertEqual(true, is_pid(fusco_cp:get_client(?POOL))),
|
||||
?assertEqual(true, is_pid(fusco_cp:get_client(?POOL))),
|
||||
?assertEqual({error, timeout}, fusco_cp:get_client(?POOL)).
|
||||
|
||||
free_client() ->
|
||||
Pid = fusco_cp:get_client(?POOL),
|
||||
?assertEqual(true, is_pid(Pid)),
|
||||
?assertEqual(ok, fusco_cp:free_client(?POOL, Pid)),
|
||||
?assertEqual(Pid, fusco_cp:get_client(?POOL)).
|
||||
|
||||
unblock_client() ->
|
||||
Client = fusco_cp:get_client(?POOL),
|
||||
?assertEqual(true, is_pid(Client)),
|
||||
?assertEqual(true, is_pid(fusco_cp:get_client(?POOL))),
|
||||
?assertEqual(true, is_pid(fusco_cp:get_client(?POOL))),
|
||||
To = self(),
|
||||
spawn(fun() ->
|
||||
Pid = fusco_cp:get_client(?POOL),
|
||||
To ! {client, Pid}
|
||||
end),
|
||||
?assertEqual(ok, fusco_cp:free_client(?POOL, Client)),
|
||||
?assertEqual({client, Client}, receive
|
||||
{client, _} = R ->
|
||||
R
|
||||
end).
|
||||
|
||||
|
|
@ -0,0 +1,207 @@
|
|||
%%%-----------------------------------------------------------------------------
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Oscar Hellström <oscar@hellstrom.st>
|
||||
%%% @author Diana Parra Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%% @end
|
||||
%%%-----------------------------------------------------------------------------
|
||||
-module(fusco_lib_tests).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-include("../include/fusco_types.hrl").
|
||||
-include("../include/fusco.hrl").
|
||||
-include_lib("eunit/include/eunit.hrl").
|
||||
|
||||
parse_url_test_() ->
|
||||
[
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 80,
|
||||
path = "/",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://host")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 80,
|
||||
path = "/",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://host/")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 443,
|
||||
path = "/",
|
||||
is_ssl = true,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("https://host")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 443,
|
||||
path = "/",
|
||||
is_ssl = true,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("https://host/")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://host:180")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://host:180/")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/foo",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://host:180/foo")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://host:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "joe",
|
||||
password = "erlang"
|
||||
},
|
||||
fusco_lib:parse_url("http://joe:erlang@host:180/foo/bar")),
|
||||
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "joe",
|
||||
password = "erl@ng"
|
||||
},
|
||||
fusco_lib:parse_url("http://joe:erl%40ng@host:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "joe",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://joe@host:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://@host:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "joe:arm",
|
||||
password = "erlang"
|
||||
},
|
||||
fusco_lib:parse_url("http://joe%3Aarm:erlang@host:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "host",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "joe:arm",
|
||||
password = "erlang/otp"
|
||||
},
|
||||
fusco_lib:parse_url("http://joe%3aarm:erlang%2Fotp@host:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "::1",
|
||||
port = 80,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://[::1]/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "::1",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://[::1]:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "::1",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "joe",
|
||||
password = "erlang"
|
||||
},
|
||||
fusco_lib:parse_url("http://joe:erlang@[::1]:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "1080:0:0:0:8:800:200c:417a",
|
||||
port = 180,
|
||||
path = "/foo/bar",
|
||||
is_ssl = false,
|
||||
user = "joe",
|
||||
password = "erlang"
|
||||
},
|
||||
fusco_lib:parse_url("http://joe:erlang@[1080:0:0:0:8:800:200C:417A]:180/foo/bar")),
|
||||
|
||||
?_assertEqual(#fusco_url{
|
||||
host = "www.example.com",
|
||||
port = 80,
|
||||
path = "/?a=b",
|
||||
is_ssl = false,
|
||||
user = "",
|
||||
password = ""
|
||||
},
|
||||
fusco_lib:parse_url("http://www.example.com?a=b"))
|
||||
].
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(fusco_protocol_SUITE).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-compile(export_all).
|
||||
|
||||
all() ->
|
||||
[prop_http_response_close_connection,
|
||||
prop_http_response_keep_alive,
|
||||
prop_chunked_http_response_keep_alive].
|
||||
|
||||
%%==============================================================================
|
||||
%% Test cases
|
||||
%%==============================================================================
|
||||
prop_http_response_close_connection(_) ->
|
||||
do_prop(prop_http_response_close_connection).
|
||||
|
||||
prop_http_response_keep_alive(_) ->
|
||||
do_prop(prop_http_response_keep_alive).
|
||||
|
||||
prop_chunked_http_response_keep_alive(_) ->
|
||||
do_prop(prop_chunked_http_response_keep_alive).
|
||||
|
||||
%%==============================================================================
|
||||
%% Internal functions
|
||||
%%==============================================================================
|
||||
do_prop(Case) ->
|
||||
case eqc:counterexample(erlang:apply(fusco_protocol_eqc, Case, [])) of
|
||||
true ->
|
||||
true;
|
||||
Value ->
|
||||
exit(Value)
|
||||
end.
|
||||
|
|
@ -0,0 +1,173 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(fusco_protocol_eqc).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-include_lib("eqc/include/eqc.hrl").
|
||||
-include("fusco.hrl").
|
||||
|
||||
-export([prop_http_response_close_connection/0,
|
||||
prop_http_response_keep_alive/0,
|
||||
prop_chunked_http_response_keep_alive/0]).
|
||||
|
||||
%%==============================================================================
|
||||
%% Quickcheck generators
|
||||
%%==============================================================================
|
||||
valid_http_message() ->
|
||||
?LET({StatusLine, Headers, Cookies},
|
||||
{http_eqc_gen:status_line(), http_eqc_gen:headers(),
|
||||
list(http_eqc_gen:set_cookie())},
|
||||
?LET(Body, http_eqc_encoding:body(StatusLine),
|
||||
{StatusLine, http_eqc_encoding:add_content_length(Headers, Body),
|
||||
Cookies, Body})).
|
||||
|
||||
valid_http_chunked_message() ->
|
||||
?LET({StatusLine, Headers, Cookies},
|
||||
{http_eqc_gen:status_line(), http_eqc_gen:headers(),
|
||||
list(http_eqc_gen:set_cookie())},
|
||||
?LET(Body, http_eqc_gen:chunked_body(),
|
||||
{StatusLine, http_eqc_encoding:add_transfer_encoding(
|
||||
Headers, <<"chunked">>),
|
||||
Cookies, Body})).
|
||||
|
||||
%%==============================================================================
|
||||
%% Quickcheck properties
|
||||
%%==============================================================================
|
||||
prop_http_response_close_connection() ->
|
||||
%% Connection is closed just after send the response
|
||||
prop_http_response(close).
|
||||
|
||||
prop_http_response_keep_alive() ->
|
||||
%% Connection stays open after send the response
|
||||
prop_http_response(keepalive).
|
||||
|
||||
prop_chunked_http_response_keep_alive() ->
|
||||
%% Connection stays open after send the response
|
||||
prop_chunked_http_response(keepalive).
|
||||
|
||||
prop_http_response(ConnectionState) ->
|
||||
eqc:numtests(
|
||||
500,
|
||||
?FORALL(ValidMessage, valid_http_message(),
|
||||
decode_valid_message(ConnectionState, ValidMessage))).
|
||||
|
||||
decode_valid_message(ConnectionState, {StatusLine, Headers, Cookies, Body}) ->
|
||||
Msg = http_eqc_encoding:build_valid_response(StatusLine, Headers, Cookies, Body),
|
||||
L = {_, _, Socket} =
|
||||
test_utils:start_listener({fragmented, Msg}, ConnectionState),
|
||||
test_utils:send_message(Socket),
|
||||
Recv = fusco_protocol:recv(Socket, false),
|
||||
test_utils:stop_listener(L),
|
||||
Expected = expected_output(StatusLine, Headers, Cookies, Body, Msg),
|
||||
Cleared = clear_record(clear_connection(Recv)),
|
||||
?WHENFAIL(io:format("Message:~n=======~n~s~n=======~nResponse:"
|
||||
" ~p~nCleared: ~p~nExpected: ~p~n",
|
||||
[binary:list_to_bin(Msg), Recv, Cleared, Expected]),
|
||||
case Cleared of
|
||||
Expected ->
|
||||
true;
|
||||
_ ->
|
||||
false
|
||||
end).
|
||||
|
||||
prop_chunked_http_response(ConnectionState) ->
|
||||
eqc:numtests(
|
||||
500,
|
||||
?FORALL(ValidMessage, valid_http_chunked_message(),
|
||||
decode_valid_message(ConnectionState, ValidMessage))).
|
||||
|
||||
%%==============================================================================
|
||||
%% Internal functions
|
||||
%%==============================================================================
|
||||
expected_output({HttpVersion, StatusCode, Reason}, Headers, Cookies, Body, Msg) ->
|
||||
Version = http_version(HttpVersion),
|
||||
OCookies = [{Name, list_to_binary(http_eqc_encoding:build_cookie(Cookie))}
|
||||
|| {Name, Cookie} <- Cookies],
|
||||
LowerHeaders = lists:reverse(headers_to_lower(Headers ++ OCookies)),
|
||||
CookiesRec = output_cookies(Cookies),
|
||||
#response{version = Version,
|
||||
status_code = StatusCode,
|
||||
reason = Reason,
|
||||
cookies = CookiesRec,
|
||||
headers = LowerHeaders,
|
||||
connection = to_lower(proplists:get_value(<<"connection">>,
|
||||
LowerHeaders)),
|
||||
body = expected_body(Body),
|
||||
content_length = content_length(Body),
|
||||
transfer_encoding = to_lower(proplists:get_value(<<"transfer-encoding">>,
|
||||
LowerHeaders)),
|
||||
size = byte_size(list_to_binary(Msg))}.
|
||||
|
||||
expected_body(Body) when is_binary(Body) ->
|
||||
Body;
|
||||
expected_body(List) ->
|
||||
list_to_binary([Bin || {_, Bin} <- List]).
|
||||
|
||||
content_length(Body) when is_binary(Body) ->
|
||||
byte_size(Body);
|
||||
content_length(_) ->
|
||||
0.
|
||||
|
||||
output_cookies(Cookies) ->
|
||||
output_cookies(Cookies, []).
|
||||
|
||||
output_cookies([{_SetCookie, {{K, V}, Avs}} | Rest], Acc) ->
|
||||
MaxAge = output_max_age(proplists:get_value(<<"Max-Age">>, Avs)),
|
||||
Path = proplists:get_value(<<"Path">>, Avs),
|
||||
PathTokens = case Path of
|
||||
Bin when is_binary(Bin) ->
|
||||
binary:split(Bin, <<"/">>, [global]);
|
||||
undefined ->
|
||||
undefined
|
||||
end,
|
||||
Expires = http_eqc_encoding:expires_datetime(proplists:get_value(<<"Expires">>, Avs)),
|
||||
Cookie = #fusco_cookie{name = K, value = V, max_age = MaxAge, path = Path,
|
||||
path_tokens = PathTokens,
|
||||
expires = Expires,
|
||||
domain = proplists:get_value(<<"Domain">>, Avs)},
|
||||
output_cookies(Rest, [Cookie | Acc]);
|
||||
output_cookies([], Acc) ->
|
||||
Acc.
|
||||
|
||||
output_max_age(undefined) ->
|
||||
undefined;
|
||||
output_max_age(Age) ->
|
||||
list_to_integer(binary_to_list(Age)) * 1000000.
|
||||
|
||||
clear_record(Response) when is_record(Response, response) ->
|
||||
Response#response{socket = undefined,
|
||||
ssl = undefined,
|
||||
in_timestamp = undefined};
|
||||
clear_record(Error) ->
|
||||
Error.
|
||||
|
||||
clear_connection(Response) when is_record(Response, response) ->
|
||||
Response#response{connection = to_lower(Response#response.connection)};
|
||||
clear_connection(Error) ->
|
||||
Error.
|
||||
|
||||
http_version(<<"HTTP/1.1">>) ->
|
||||
{1, 1};
|
||||
http_version(<<"HTTP/1.0">>) ->
|
||||
{1, 0}.
|
||||
|
||||
headers_to_lower(Headers) ->
|
||||
[begin
|
||||
He = to_lower(H),
|
||||
case He of
|
||||
LH when LH == <<"connection">>; LH == <<"transfer-encoding">> ->
|
||||
{He, to_lower(V)};
|
||||
_ ->
|
||||
{He, V}
|
||||
end
|
||||
end || {H, V} <- Headers].
|
||||
|
||||
to_lower(undefined) ->
|
||||
undefined;
|
||||
to_lower(Bin) ->
|
||||
list_to_binary(string:to_lower(binary_to_list(Bin))).
|
||||
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(fusco_protocol_tests).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-include_lib("eunit/include/eunit.hrl").
|
||||
-include("fusco.hrl").
|
||||
|
||||
-export([test_decode_header/0]).
|
||||
|
||||
fusco_protocol_test_() ->
|
||||
[{"HTTP version", ?_test(http_version())},
|
||||
{"Cookies", ?_test(cookies())},
|
||||
{"Decode header", ?_test(decode_header())}].
|
||||
|
||||
http_version() ->
|
||||
L = {_, _, Socket} = test_utils:start_listener(cookie_message()),
|
||||
test_utils:send_message(Socket),
|
||||
?assertMatch(#response{version = {1,1},
|
||||
status_code = <<"200">>,
|
||||
reason = <<"OK">>,
|
||||
body = <<"Great success!">>},
|
||||
fusco_protocol:recv(Socket, false)),
|
||||
test_utils:stop_listener(L).
|
||||
|
||||
cookies() ->
|
||||
L = {_, _, Socket} = test_utils:start_listener(cookie_message()),
|
||||
test_utils:send_message(Socket),
|
||||
Recv = fusco_protocol:recv(Socket, false),
|
||||
test_utils:stop_listener(L),
|
||||
?assertMatch(#response{version = {1,1},
|
||||
status_code = <<"200">>,
|
||||
reason = <<"OK">>,
|
||||
headers = [{<<"set-cookie">>,<<"name2=value2; Expires=Wed, 09 Jun 2021 10:18:14 GMT">>},
|
||||
{<<"set-cookie">>,<<"name=value">>} | _],
|
||||
body = <<"Great success!">>},
|
||||
Recv).
|
||||
|
||||
decode_header() ->
|
||||
?assertMatch(#response{
|
||||
headers = [{<<"set-cookie">>,<<"name2=value2; Expires=Wed, 09 Jun 2021 10:18:14 GMT">>},
|
||||
{<<"set-cookie">>,<<"name=value">>},
|
||||
{<<"content-length">>, <<"14">>},
|
||||
{<<"content-type">>,<<"text/plain">>}],
|
||||
body = <<"Great success!">>},
|
||||
test_decode_header()).
|
||||
|
||||
test_decode_header() ->
|
||||
fusco_protocol:decode_header(header(), <<>>, #response{}).
|
||||
|
||||
header() ->
|
||||
<<"Content-type: text/plain\r\nContent-length: 14\r\nSet-Cookie: name=value\r\nSet-Cookie: name2=value2; Expires=Wed, 09 Jun 2021 10:18:14 GMT\r\n\r\nGreat success!">>.
|
||||
|
||||
cookie_message() ->
|
||||
[
|
||||
"HTTP/1.1 200 OK\r\n"
|
||||
"Content-type: text/plain\r\nContent-length: 14\r\n"
|
||||
"Set-Cookie: name=value\r\n"
|
||||
"Set-Cookie: name2=value2; Expires=Wed, 09 Jun 2021 10:18:14 GMT\r\n"
|
||||
"\r\n"
|
||||
"Great success!"
|
||||
].
|
||||
|
|
@ -0,0 +1,201 @@
|
|||
%%% ----------------------------------------------------------------------------
|
||||
%%% Copyright (c) 2009, Erlang Training and Consulting Ltd.
|
||||
%%% All rights reserved.
|
||||
%%%
|
||||
%%% Redistribution and use in source and binary forms, with or without
|
||||
%%% modification, are permitted provided that the following conditions are met:
|
||||
%%% * Redistributions of source code must retain the above copyright
|
||||
%%% notice, this list of conditions and the following disclaimer.
|
||||
%%% * Redistributions in binary form must reproduce the above copyright
|
||||
%%% notice, this list of conditions and the following disclaimer in the
|
||||
%%% documentation and/or other materials provided with the distribution.
|
||||
%%% * Neither the name of Erlang Training and Consulting Ltd. nor the
|
||||
%%% names of its contributors may be used to endorse or promote products
|
||||
%%% derived from this software without specific prior written permission.
|
||||
%%%
|
||||
%%% THIS SOFTWARE IS PROVIDED BY Erlang Training and Consulting Ltd. ''AS IS''
|
||||
%%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
%%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
%%% ARE DISCLAIMED. IN NO EVENT SHALL Erlang Training and Consulting Ltd. BE
|
||||
%%% LIABLE SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
|
||||
%%% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
%%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
%%% OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
%%% ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
%%% ----------------------------------------------------------------------------
|
||||
|
||||
%%% @author Oscar Hellström <oscar@hellstrom.st>
|
||||
-module(fusco_tests).
|
||||
|
||||
-export([test_no/2]).
|
||||
|
||||
-include_lib("eunit/include/eunit.hrl").
|
||||
|
||||
test_no(N, Tests) ->
|
||||
setelement(2, Tests,
|
||||
setelement(4, element(2, Tests),
|
||||
lists:nth(N, element(4, element(2, Tests))))).
|
||||
|
||||
%%% Eunit setup stuff
|
||||
|
||||
start_app() ->
|
||||
[application:start(App) || App <- apps()].
|
||||
|
||||
apps() ->
|
||||
[crypto, asn1, public_key, ssl].
|
||||
|
||||
stop_app(_) ->
|
||||
[application:stop(App) || App <- lists:reverse(apps())].
|
||||
|
||||
tcp_test_() ->
|
||||
{inorder,
|
||||
{setup, fun start_app/0, fun stop_app/1, [
|
||||
?_test(get_with_connect_options()),
|
||||
?_test(no_content_length()),
|
||||
?_test(no_content_length_1_0()),
|
||||
?_test(pre_1_1_server_connection()),
|
||||
?_test(pre_1_1_server_keep_alive()),
|
||||
?_test(post_100_continue()),
|
||||
?_test(request_timeout()),
|
||||
?_test(trailing_space_header()),
|
||||
?_test(closed_after_timeout())
|
||||
]}
|
||||
}.
|
||||
|
||||
options_test() ->
|
||||
invalid_options().
|
||||
|
||||
get_with_connect_options() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp, [fun webserver_utils:empty_body/5]),
|
||||
URL = url(Port),
|
||||
Options = [{connect_options, [{ip, {127, 0, 0, 1}}, {port, 0}]}],
|
||||
{ok, Client} = fusco:start(URL, Options),
|
||||
{ok, Response} = fusco:request(Client, <<"/empty">>, "GET", [], [], 1, 1000),
|
||||
?assertEqual({<<"200">>, <<"OK">>}, status(Response)),
|
||||
?assertEqual(<<>>, body(Response)).
|
||||
|
||||
no_content_length() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp, [fun webserver_utils:no_content_length/5]),
|
||||
URL = url(Port),
|
||||
{ok, Client} = fusco:start(URL, []),
|
||||
{ok, Response} = fusco:request(Client, <<"/no_cl">>, "GET", [], [], 1000),
|
||||
?assertEqual({<<"200">>, <<"OK">>}, status(Response)),
|
||||
?assertEqual(list_to_binary(webserver_utils:default_string()), body(Response)).
|
||||
|
||||
no_content_length_1_0() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp, [fun webserver_utils:no_content_length_1_0/5]),
|
||||
URL = url(Port),
|
||||
{ok, Client} = fusco:start(URL, []),
|
||||
{ok, Response} = fusco:request(Client, <<"/no_cl">>, "GET", [], [], 1000),
|
||||
?assertEqual({<<"200">>, <<"OK">>}, status(Response)),
|
||||
?assertEqual(list_to_binary(webserver_utils:default_string()), body(Response)).
|
||||
|
||||
%% Check the header value is trimming spaces on header values
|
||||
%% which can cause crash in fusco_client:body_type when Content-Length
|
||||
%% is converted from list to integer
|
||||
trailing_space_header() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp, [fun webserver_utils:trailing_space_header/5]),
|
||||
URL = url(Port),
|
||||
{ok, Client} = fusco:start(URL, []),
|
||||
{ok, Response} = fusco:request(Client, <<"/no_cl">>, "GET", [], [], 1000),
|
||||
Headers = headers(Response),
|
||||
ContentLength = fusco_lib:header_value(<<"content-length">>, Headers),
|
||||
?assertEqual(<<"14">>, ContentLength).
|
||||
|
||||
pre_1_1_server_connection() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp, [fun webserver_utils:pre_1_1_server/5]),
|
||||
URL = url(Port),
|
||||
Body = pid_to_list(self()),
|
||||
{ok, Client} = fusco:start(URL, []),
|
||||
{ok, _} = fusco:request(Client, <<"/close">>, "PUT", [], Body, 1000),
|
||||
% Wait for the server to see that socket has been closed.
|
||||
% The socket should be closed by us since the server responded with a
|
||||
% 1.0 version, and not the Connection: keep-alive header.
|
||||
receive closed -> ok end.
|
||||
|
||||
pre_1_1_server_keep_alive() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp,
|
||||
[
|
||||
fun webserver_utils:pre_1_1_server_keep_alive/5,
|
||||
fun webserver_utils:pre_1_1_server/5
|
||||
]),
|
||||
URL = url(Port),
|
||||
Body = pid_to_list(self()),
|
||||
{ok, Client} = fusco:start(URL, []),
|
||||
{ok, Response1} = fusco:request(Client, <<"/close">>, "GET", [], [], 1000),
|
||||
{ok, Response2} = fusco:request(Client, <<"/close">>, "PUT", [], Body, 1000),
|
||||
?assertEqual({<<"200">>, <<"OK">>}, status(Response1)),
|
||||
?assertEqual({<<"200">>, <<"OK">>}, status(Response2)),
|
||||
?assertEqual(list_to_binary(webserver_utils:default_string()), body(Response1)),
|
||||
?assertEqual(list_to_binary(webserver_utils:default_string()), body(Response2)),
|
||||
% Wait for the server to see that socket has been closed.
|
||||
% The socket should be closed by us since the server responded with a
|
||||
% 1.0 version, and not the Connection: keep-alive header.
|
||||
receive closed -> ok end.
|
||||
|
||||
post_100_continue() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp, [fun webserver_utils:copy_body_100_continue/5]),
|
||||
URL = url(Port),
|
||||
{X, Y, Z} = now(),
|
||||
Body = [
|
||||
"This is a rather simple post :)",
|
||||
integer_to_list(X),
|
||||
integer_to_list(Y),
|
||||
integer_to_list(Z)
|
||||
],
|
||||
{ok, Client} = fusco:start(URL, []),
|
||||
{ok, Response} = fusco:request(Client, <<"/post">>, "POST", [], Body, 1000),
|
||||
{StatusCode, ReasonPhrase} = status(Response),
|
||||
?assertEqual(<<"200">>, StatusCode),
|
||||
?assertEqual(<<"OK">>, ReasonPhrase),
|
||||
?assertEqual(iolist_to_binary(Body), body(Response)).
|
||||
|
||||
request_timeout() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp, [fun webserver_utils:very_slow_response/5]),
|
||||
URL = url(Port),
|
||||
{ok, Client} = fusco:start(URL, []),
|
||||
?assertEqual({error, timeout}, fusco:request(Client, <<"/slow">>, "GET", [], [], 50)).
|
||||
|
||||
invalid_options() ->
|
||||
URL = url(5050),
|
||||
?assertError({bad_option, bad_option},
|
||||
fusco:start(URL, [bad_option, {foo, bar}])),
|
||||
?assertError({bad_option, {foo, bar}},
|
||||
fusco:start(URL, [{foo, bar}, bad_option])).
|
||||
|
||||
closed_after_timeout() ->
|
||||
{ok, _, _, Port} = webserver:start(gen_tcp, [fun webserver_utils:no_response/5, stay_open]),
|
||||
URL = url(Port),
|
||||
{ok, Client} = fusco:start(URL, []),
|
||||
fusco:request(Client, <<"/slow">>, "GET", [], [], 50),
|
||||
fusco:disconnect(Client),
|
||||
wait_for_exit(10, Client),
|
||||
?assertEqual(false,erlang:is_process_alive(Client)).
|
||||
|
||||
wait_for_exit(0, _) ->
|
||||
ok;
|
||||
wait_for_exit(N, Proc) ->
|
||||
timer:sleep(50),
|
||||
case is_process_alive(Proc) of
|
||||
false ->
|
||||
ok;
|
||||
true ->
|
||||
wait_for_exit(N - 1, Proc)
|
||||
end.
|
||||
|
||||
url(Port) ->
|
||||
url(inet, Port).
|
||||
|
||||
url(inet, Port) ->
|
||||
"http://localhost:" ++ integer_to_list(Port);
|
||||
url(inet6, Port) ->
|
||||
"http://[::1]:" ++ integer_to_list(Port).
|
||||
|
||||
status({Status, _, _, _, _}) ->
|
||||
Status.
|
||||
|
||||
body({_, _, Body, _, _}) ->
|
||||
Body.
|
||||
|
||||
headers({_, Headers, _, _, _}) ->
|
||||
Headers.
|
||||
|
|
@ -0,0 +1,102 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(fusco_tests_SUITE).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-include_lib("common_test/include/ct.hrl").
|
||||
|
||||
-compile(export_all).
|
||||
|
||||
all() ->
|
||||
[{group, ipv4}, {group, ipv6}, {group, ipv4ssl}, {group, ipv6ssl},
|
||||
{group, independent}].
|
||||
|
||||
init_per_group(ipv4, Config) ->
|
||||
[{fusco_parameters, {"127.0.0.1", inet, false}} | Config];
|
||||
init_per_group(ipv6, Config) ->
|
||||
[{fusco_parameters, {"::1", inet6, false}} | Config];
|
||||
init_per_group(ipv4ssl, Config) ->
|
||||
[ok = application:start(App) || App <- apps()],
|
||||
[{fusco_parameters, {"127.0.0.1", inet, true}} | Config];
|
||||
init_per_group(ipv6ssl, Config) ->
|
||||
[ok = application:start(App) || App <- apps()],
|
||||
[{fusco_parameters, {"::1", inet6, true}} | Config];
|
||||
init_per_group(independent, Config) ->
|
||||
[{fusco_parameters, {"127.0.0.1", inet, false}} | Config].
|
||||
|
||||
end_per_group(ipv4, _Config) ->
|
||||
ok;
|
||||
end_per_group(ipv6, _Config) ->
|
||||
ok;
|
||||
end_per_group(ipv4ssl, _Config) ->
|
||||
[application:stop(App) || App <- lists:reverse(apps())],
|
||||
ok;
|
||||
end_per_group(ipv6ssl, _Config) ->
|
||||
[application:stop(App) || App <- lists:reverse(apps())],
|
||||
ok;
|
||||
end_per_group(independent, _Config) ->
|
||||
ok.
|
||||
|
||||
apps() ->
|
||||
[asn1, crypto, public_key, ssl, fusco].
|
||||
|
||||
groups() ->
|
||||
[{ipv4, [], all_tests()},
|
||||
{ipv6, [], all_tests()},
|
||||
{ipv4ssl, [], all_tests()},
|
||||
{ipv6ssl, [], all_tests()},
|
||||
{independent, [], independent_tests()}].
|
||||
|
||||
all_tests() ->
|
||||
[prop_http_request, prop_persistent_connection, prop_reconnect,
|
||||
prop_client_close_connection, prop_connection_refused].
|
||||
|
||||
independent_tests() ->
|
||||
[prop_http_request_cookie_path, prop_http_request_supersede_cookie,
|
||||
prop_http_request_max_age, prop_http_request_expires].
|
||||
|
||||
%%==============================================================================
|
||||
%% Test cases
|
||||
%%==============================================================================
|
||||
prop_http_request(Config) ->
|
||||
do_prop(prop_http_request_per_family, Config).
|
||||
|
||||
prop_persistent_connection(Config) ->
|
||||
do_prop(prop_persistent_connection_per_family, Config).
|
||||
|
||||
prop_reconnect(Config) ->
|
||||
do_prop(prop_reconnect_per_family, Config).
|
||||
|
||||
prop_client_close_connection(Config) ->
|
||||
do_prop(prop_client_close_connection_per_family, Config).
|
||||
|
||||
prop_connection_refused(Config) ->
|
||||
do_prop(prop_connection_refused_per_family, Config).
|
||||
|
||||
prop_http_request_cookie_path(Config) ->
|
||||
do_prop(prop_http_request_cookie_path, Config).
|
||||
|
||||
prop_http_request_supersede_cookie(Config) ->
|
||||
do_prop(prop_http_request_supersede_cookie, Config).
|
||||
|
||||
prop_http_request_max_age(Config) ->
|
||||
do_prop(prop_http_request_max_age, Config).
|
||||
|
||||
prop_http_request_expires(Config) ->
|
||||
do_prop(prop_http_request_expires, Config).
|
||||
|
||||
%%==============================================================================
|
||||
%% Internal functions
|
||||
%%==============================================================================
|
||||
do_prop(Case, Config) ->
|
||||
{Ip, Family, Ssl} = ?config(fusco_parameters, Config),
|
||||
case eqc:counterexample(erlang:apply(fusco_tests_eqc, Case, [Ip, Family, Ssl])) of
|
||||
true ->
|
||||
true;
|
||||
Value ->
|
||||
exit(Value)
|
||||
end.
|
||||
|
|
@ -0,0 +1,676 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(fusco_tests_eqc).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-include_lib("eqc/include/eqc.hrl").
|
||||
-include("fusco.hrl").
|
||||
|
||||
-define(TWO_OK, <<"HTTP/1.1 200 OK\r\n\r\n">>).
|
||||
-define(FOUR_BAD_REQUEST, <<"HTTP/1.1 400 Bad Request\r\n">>).
|
||||
-define(TWO_OK(V), case V of
|
||||
undefined ->
|
||||
?TWO_OK;
|
||||
_ ->
|
||||
<<"HTTP/1.1 200 OK\r\nConnection: ",
|
||||
V/binary,"\r\n\r\n">>
|
||||
end).
|
||||
|
||||
-export([prop_http_request_per_family/3,
|
||||
prop_persistent_connection_per_family/3,
|
||||
prop_reconnect_per_family/3,
|
||||
prop_client_close_connection_per_family/3,
|
||||
prop_connection_refused_per_family/3,
|
||||
prop_http_request_cookie_path/3,
|
||||
prop_http_request_supersede_cookie/3,
|
||||
prop_http_request_max_age/3,
|
||||
prop_http_request_expires/3]).
|
||||
|
||||
%%==============================================================================
|
||||
%% Quickcheck generators
|
||||
%%==============================================================================
|
||||
valid_http_request() ->
|
||||
?LET({RequestLine, Headers},
|
||||
{http_eqc_gen:request_line(), http_eqc_gen:request_headers()},
|
||||
?LET(Body, http_eqc_encoding:body(any),
|
||||
{RequestLine, http_eqc_encoding:add_content_length(Headers, Body),
|
||||
Body})).
|
||||
|
||||
valid_http_response() ->
|
||||
?LET({StatusLine, Headers},
|
||||
{status_line(), http_eqc_gen:headers()},
|
||||
?LET(Body, http_eqc_encoding:body(StatusLine),
|
||||
{StatusLine, Headers, Body}
|
||||
)
|
||||
).
|
||||
|
||||
status_line() ->
|
||||
%% Discard CONTINUE for cookie testing, client waits for next messages
|
||||
?SUCHTHAT({_, S, _}, http_eqc_gen:status_line(),
|
||||
not lists:member(S, [<<"100">>, <<"101">>])).
|
||||
|
||||
token() ->
|
||||
non_empty(list(choose($A, $z))).
|
||||
|
||||
path() ->
|
||||
?LET({Path, Slash}, {non_empty(list(token())), slash()},
|
||||
Path ++ Slash).
|
||||
|
||||
domain() ->
|
||||
?LET(Domain, path(), list_to_binary(string:join(Domain, "."))).
|
||||
|
||||
slash() ->
|
||||
oneof([["/"], []]).
|
||||
|
||||
subpath(Path, true) ->
|
||||
?LET({Length, Slash}, {choose(1, length(Path)), slash()},
|
||||
begin
|
||||
{H, _} = lists:split(Length, Path),
|
||||
case lists:last(H) of
|
||||
"/" ->
|
||||
H;
|
||||
_ ->
|
||||
H ++ Slash
|
||||
end
|
||||
end);
|
||||
subpath(Path, false) ->
|
||||
?SUCHTHAT(SubPath, path(), hd(SubPath) =/= hd(Path)).
|
||||
|
||||
max_age() ->
|
||||
%% Make cookie expire on nat/0 and not expire on largeint/0
|
||||
%% Otherwise, in black box testing we lose the control to make cookie
|
||||
%% expire on values near the current time. It needs unit testing
|
||||
%% to verify the expiration is precise.
|
||||
?LET({Expires, MaxAge},
|
||||
oneof([{true, nat()}, {false, largeint()}]),
|
||||
case MaxAge of
|
||||
0 ->
|
||||
{true, MaxAge};
|
||||
_ ->
|
||||
{Expires, abs(MaxAge)}
|
||||
end).
|
||||
|
||||
past() ->
|
||||
?SUCHTHAT(Date, http_eqc_gen:sane_cookie_date(), is_past(Date)).
|
||||
|
||||
future() ->
|
||||
?SUCHTHAT(Date, http_eqc_gen:sane_cookie_date(), is_future(Date)).
|
||||
|
||||
expires() ->
|
||||
oneof([{true, past()}, {false, future()}]).
|
||||
|
||||
set_cookie(Path) ->
|
||||
{<<"Set-Cookie">>, {http_eqc_gen:cookie_pair(),
|
||||
[{<<"Path">>, encode_path(Path)}]}}.
|
||||
|
||||
set_cookie(Path, MaxAge) when is_integer(MaxAge) ->
|
||||
{<<"Set-Cookie">>, {http_eqc_gen:cookie_pair(),
|
||||
[{<<"Path">>, encode_path(Path)},
|
||||
{<<"Max-Age">>, integer_to_binary(MaxAge)}]}};
|
||||
set_cookie(Path, Expires) ->
|
||||
{<<"Set-Cookie">>,
|
||||
{http_eqc_gen:cookie_pair(),
|
||||
[{<<"Path">>, encode_path(Path)},
|
||||
{<<"Expires">>, Expires}]}}.
|
||||
|
||||
set_cookie(Path, Domain, Name, Value) ->
|
||||
{<<"Set-Cookie">>, {{Name, Value}, [{<<"Path">>, encode_path(Path)},
|
||||
{<<"Domain">>, Domain}]}}.
|
||||
|
||||
cookie_path() ->
|
||||
%% Cookie rejected if the value for the Path attribute
|
||||
%% is not a prefix of the requested-URI
|
||||
?LET({Path, IsSubPath}, {path(), bool()},
|
||||
?LET(SubPath, subpath(Path, IsSubPath),
|
||||
?LET(Cookie, set_cookie(SubPath),
|
||||
{Cookie, encode_path(Path), IsSubPath}
|
||||
)
|
||||
)
|
||||
).
|
||||
|
||||
cookie_max_age() ->
|
||||
%% Path is needed in the test setup to ensure cookie is not rejected
|
||||
?LET({Path, {Expires, MaxAge}}, {path(), max_age()},
|
||||
?LET(Cookie, set_cookie(Path, MaxAge),
|
||||
{Cookie, encode_path(Path), Expires, MaxAge}
|
||||
)
|
||||
).
|
||||
|
||||
cookie_expires() ->
|
||||
%% Path is needed in the test setup to ensure cookie is not rejected
|
||||
?LET({Path, {Expires, Date}}, {path(), expires()},
|
||||
?LET(Cookie, set_cookie(Path, Date),
|
||||
{Cookie, encode_path(Path), Expires}
|
||||
)
|
||||
).
|
||||
|
||||
maybe_different_cookie_data(true, Path, Domain, Name) ->
|
||||
{Path, Domain, Name};
|
||||
maybe_different_cookie_data(false, Path, Domain, Name) ->
|
||||
%% Generates a combination of 1 or more mutations on Path, Domain and Name
|
||||
?LET([ChangePath, ChangeDomain, ChangeName],
|
||||
?SUCHTHAT(V, vector(3, bool()),
|
||||
lists:any(fun(X) -> X == true end, V)),
|
||||
{change_path(ChangePath, Path),
|
||||
change_domain(ChangeDomain, Domain),
|
||||
change_name(ChangeName, Name)}
|
||||
).
|
||||
|
||||
change_path(false, Path) ->
|
||||
Path;
|
||||
change_path(true, Path) ->
|
||||
?SUCHTHAT(P, path(), hd(P) =/= hd(Path)).
|
||||
|
||||
change_domain(false, Domain) ->
|
||||
Domain;
|
||||
change_domain(true, Domain) ->
|
||||
?SUCHTHAT(D, domain(), D =/= Domain).
|
||||
|
||||
change_name(false, Name) ->
|
||||
Name;
|
||||
change_name(true, Name) ->
|
||||
?SUCHTHAT(N, http_eqc_gen:small_valid_bin(), N =/= Name).
|
||||
|
||||
%%==============================================================================
|
||||
%% Quickcheck properties
|
||||
%%==============================================================================
|
||||
prop_http_request_per_family(Host, Family, Ssl) ->
|
||||
eqc:numtests(
|
||||
500,
|
||||
?FORALL({{Method, Uri, _Version}, Headers, Body} = Msg,
|
||||
valid_http_request(),
|
||||
begin
|
||||
Module = select_module(Ssl),
|
||||
{ok, Listener, LS, Port} =
|
||||
webserver:start(Module, [validate_msg(Msg)], Family),
|
||||
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
|
||||
{ok, {Status, _, _, _, _}}
|
||||
= fusco:request(Client, Uri, Method, Headers, Body, 10000),
|
||||
ok = fusco:disconnect(Client),
|
||||
webserver:stop(Module, Listener, LS),
|
||||
Expected = {<<"200">>, <<"OK">>},
|
||||
?WHENFAIL(io:format("Status: ~p~nExpected: ~p~n",
|
||||
[Status, Expected]),
|
||||
case Status of
|
||||
Expected ->
|
||||
true;
|
||||
_ ->
|
||||
false
|
||||
end)
|
||||
end)).
|
||||
|
||||
prop_persistent_connection_per_family(Host, Family, Ssl) ->
|
||||
%% Fusco must keep the connection alive and be able to reconnect
|
||||
%% Individual properties defined for reconnect and keep-alive
|
||||
?FORALL(
|
||||
Msgs,
|
||||
non_empty(list({valid_http_request(), http_eqc_gen:connection_header()})),
|
||||
begin
|
||||
Module = select_module(Ssl),
|
||||
{ok, Listener, LS, Port} =
|
||||
webserver:start(Module,
|
||||
[reply_msg(?TWO_OK(ConHeader)) || {_, ConHeader} <- Msgs],
|
||||
Family),
|
||||
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
|
||||
Replies = lists:map(fun({{{Method, Uri, _Version}, Headers, Body}, _}) ->
|
||||
fusco:request(Client, Uri, Method, Headers, Body, 10000)
|
||||
end, Msgs),
|
||||
ok = fusco:disconnect(Client),
|
||||
webserver:stop(Module, Listener, LS),
|
||||
?WHENFAIL(io:format("Replies: ~p~nExpected: 200 OK~n", [Replies]),
|
||||
lists:all(fun({ok, {{<<"200">>, <<"OK">>}, _, _, _, _}}) ->
|
||||
true;
|
||||
(_) ->
|
||||
false
|
||||
end, Replies))
|
||||
end).
|
||||
|
||||
prop_reconnect_per_family(Host, Family, Ssl) ->
|
||||
%% Connection is always closed in the server and fusco must reconnect
|
||||
eqc:numtests(
|
||||
50,
|
||||
?FORALL(
|
||||
Msgs,
|
||||
non_empty(list(valid_http_request())),
|
||||
begin
|
||||
Module = select_module(Ssl),
|
||||
{ok, Listener, LS, Port} =
|
||||
webserver:start(Module,
|
||||
[reply_and_close_msg(?TWO_OK) || _ <- Msgs],
|
||||
Family),
|
||||
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
|
||||
Replies = lists:map(fun({{Method, Uri, _Version}, Headers, Body}) ->
|
||||
Hdrs = lists:keydelete(<<"Connection">>, 1, Headers),
|
||||
fusco:request(Client, Uri, Method, Hdrs, Body, 10000)
|
||||
end, Msgs),
|
||||
ok = fusco:disconnect(Client),
|
||||
webserver:stop(Module, Listener, LS),
|
||||
?WHENFAIL(io:format("Replies: ~p~nExpected: 200 OK~n", [Replies]),
|
||||
lists:all(fun({ok, {{<<"200">>, <<"OK">>}, _, _, _, _}}) ->
|
||||
true;
|
||||
(_) ->
|
||||
false
|
||||
end, Replies))
|
||||
end)).
|
||||
|
||||
prop_client_close_connection_per_family(Host, Family, Ssl) ->
|
||||
%% Fusco must close the connection if requested by the server
|
||||
eqc:numtests(
|
||||
25,
|
||||
?FORALL({{{Method, Uri, _Version}, Headers, Body}, Connection},
|
||||
{valid_http_request(), http_eqc_gen:connection_header()},
|
||||
begin
|
||||
Id = erlang:now(),
|
||||
Module = select_module(Ssl),
|
||||
{ok, Listener, LS, Port} =
|
||||
webserver:start(Module,
|
||||
[reply_msg_and_check(Id, ?TWO_OK(Connection))],
|
||||
Family),
|
||||
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
|
||||
{ok, {Status, _, _, _, _}}
|
||||
= fusco:request(Client, Uri, Method, Headers, Body, 10000),
|
||||
Closed = receive
|
||||
{Id, closed} ->
|
||||
true
|
||||
after 1000 ->
|
||||
false
|
||||
end,
|
||||
ok = fusco:disconnect(Client),
|
||||
webserver:stop(Module, Listener, LS),
|
||||
Expected = {<<"200">>, <<"OK">>},
|
||||
MustClose = must_close(Headers, Connection),
|
||||
?WHENFAIL(io:format("Connection: ~p~nStatus: ~p~nExpected:"
|
||||
" ~p~nMust close: ~p~nClosed: ~p~n",
|
||||
[Connection, Status, Expected, MustClose, Closed]),
|
||||
case Status of
|
||||
Expected ->
|
||||
MustClose == Closed;
|
||||
_ ->
|
||||
false
|
||||
end)
|
||||
end)).
|
||||
|
||||
prop_connection_refused_per_family(Host, Family, Ssl) ->
|
||||
eqc:numtests(1,
|
||||
begin
|
||||
Module = select_module(Ssl),
|
||||
{ok, Listener, LS, Port} =
|
||||
webserver:start(Module, [reply_msg(<<>>)], Family),
|
||||
webserver:stop(Module, Listener, LS),
|
||||
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
|
||||
Reply = fusco:connect(Client),
|
||||
Expected = {error, econnrefused},
|
||||
?WHENFAIL(io:format("Reply: ~p~nExpected: ~p~n",
|
||||
[Reply, Expected]),
|
||||
case Reply of
|
||||
Expected ->
|
||||
true;
|
||||
_ ->
|
||||
false
|
||||
end)
|
||||
end).
|
||||
|
||||
%% Cookie rejected if the value for the Path attribute
|
||||
%% is not a prefix of the requested-URI
|
||||
prop_http_request_cookie_path(Host, Family, Ssl) ->
|
||||
?FORALL(
|
||||
{Request, {Cookie, Path, IsSubPath},
|
||||
{{_, Status, Reason}, _, _} = Response},
|
||||
{valid_http_request(), cookie_path(), valid_http_response()},
|
||||
begin
|
||||
ResponseBin = build_response(Response, [Cookie]),
|
||||
ValidationFun = validate_cookie(ResponseBin, fun check_cookie_deleted/3,
|
||||
[not IsSubPath, Cookie]),
|
||||
Responses =
|
||||
send_cookie_requests(Host, Ssl, Family, ValidationFun, Path, Request,
|
||||
[<<"first">>, <<"second">>], 0),
|
||||
check_responses(Status, Reason, Responses)
|
||||
end
|
||||
).
|
||||
|
||||
%% Supersed old cookie if Name is the same as existing cookie,
|
||||
%% and Domain and Path exactly match pre-existing ones
|
||||
prop_http_request_supersede_cookie(Host, Family, Ssl) ->
|
||||
?FORALL(
|
||||
{Request, Path, Domain, {Name, Value}, Supersede,
|
||||
{{_, Status, Reason}, _, _} = Response},
|
||||
{valid_http_request(), path(), domain(), http_eqc_gen:cookie_pair(),
|
||||
bool(), valid_http_response()},
|
||||
%% Generate a second cookie that could supersed or not the previous one
|
||||
%% Uses 'Supersede' as generation parameter
|
||||
?LET(
|
||||
{{SPath, SDomain, SName}, SValue},
|
||||
{maybe_different_cookie_data(Supersede, Path, Domain, Name),
|
||||
?SUCHTHAT(V, http_eqc_gen:small_valid_bin(), V =/= Value)},
|
||||
begin
|
||||
FirstCookie = set_cookie(Path, Domain, Name, Value),
|
||||
SecondCookie = set_cookie(SPath, SDomain, SName, SValue),
|
||||
FirstServerResponse = build_response(Response, [FirstCookie]),
|
||||
SecondServerResponse = build_response(Response, [SecondCookie]),
|
||||
ValidationFun = validate_cookie_supersede(
|
||||
FirstServerResponse, SecondServerResponse,
|
||||
Supersede, {Name, Value, encode_path(Path), Domain},
|
||||
{SName, SValue, encode_path(SPath), SDomain}),
|
||||
%% Three requests to supersede the value
|
||||
%% First get cookie
|
||||
%% Second get second cookie
|
||||
%% Third checks received cookies
|
||||
Responses =
|
||||
send_cookie_requests(Host, Ssl, Family, ValidationFun,
|
||||
encode_path(Path), Request,
|
||||
[<<"first">>, <<"second">>, <<"third">>], 0),
|
||||
check_responses(Status, Reason, Responses)
|
||||
end
|
||||
)
|
||||
).
|
||||
|
||||
prop_http_request_max_age(Host, Family, Ssl) ->
|
||||
eqc:numtests(
|
||||
25,
|
||||
?FORALL(
|
||||
{Request, {Cookie, Path, Expires, MaxAge},
|
||||
{{_, Status, Reason}, _, _} = Response},
|
||||
{valid_http_request(), cookie_max_age(), valid_http_response()},
|
||||
begin
|
||||
ResponseBin = build_response(Response, [Cookie]),
|
||||
ValidationFun = validate_cookie(ResponseBin, fun check_cookie_deleted/3,
|
||||
[Expires, Cookie]),
|
||||
WaitTime = expiration_time(Expires, MaxAge),
|
||||
Responses =
|
||||
send_cookie_requests(Host, Ssl, Family, ValidationFun, Path,
|
||||
Request, [<<"first">>, <<"second">>],
|
||||
WaitTime),
|
||||
check_responses(Status, Reason, Responses)
|
||||
end
|
||||
)
|
||||
).
|
||||
|
||||
prop_http_request_expires(Host, Family, Ssl) ->
|
||||
?FORALL(
|
||||
{Request, {Cookie, Path, Expires},
|
||||
{{_, Status, Reason}, _, _} = Response},
|
||||
{valid_http_request(), cookie_expires(), valid_http_response()},
|
||||
begin
|
||||
ResponseBin = build_response(Response, [Cookie]),
|
||||
ValidationFun = validate_cookie(ResponseBin, fun check_cookie_deleted/3,
|
||||
[Expires, Cookie]),
|
||||
Responses =
|
||||
send_cookie_requests(Host, Ssl, Family, ValidationFun, Path,
|
||||
Request, [<<"first">>, <<"second">>], 0),
|
||||
check_responses(Status, Reason, Responses)
|
||||
end
|
||||
).
|
||||
%%==============================================================================
|
||||
%% Internal functions
|
||||
%%==============================================================================
|
||||
validate_msg({{_Method, _Uri, _Version}, SentHeaders, SentBody}) ->
|
||||
fun(Module, Socket, _Request, GotHeaders, GotBody) when SentBody == GotBody ->
|
||||
case validate_headers(SentBody, GotHeaders, SentHeaders) of
|
||||
true ->
|
||||
Module:send(Socket, ?TWO_OK);
|
||||
false ->
|
||||
Module:send(Socket, ?FOUR_BAD_REQUEST)
|
||||
end;
|
||||
(Module, Socket, _Request, _GotHeaders, _) ->
|
||||
Module:send(Socket, ?FOUR_BAD_REQUEST)
|
||||
end.
|
||||
|
||||
validate_cookie(Response, Fun, Params) ->
|
||||
fun(Module, Socket, _Request, Headers, _Body) ->
|
||||
case proplists:get_value("Test", Headers) of
|
||||
"first" ->
|
||||
Module:send(Socket, Response);
|
||||
"second" ->
|
||||
case erlang:apply(Fun, [Headers | Params]) of
|
||||
true ->
|
||||
Module:send(Socket, ?TWO_OK);
|
||||
false ->
|
||||
Module:send(Socket, ?FOUR_BAD_REQUEST)
|
||||
end
|
||||
end
|
||||
end.
|
||||
|
||||
validate_cookie_supersede(FirstResponse, SecondResponse, Supersede, FirstPair,
|
||||
SecondPair) ->
|
||||
fun(Module, Socket, _Request, Headers, _Body) ->
|
||||
case proplists:get_value("Test", Headers) of
|
||||
"first" ->
|
||||
Module:send(Socket, FirstResponse);
|
||||
"second" ->
|
||||
Module:send(Socket, SecondResponse);
|
||||
"third" ->
|
||||
case check_cookie_supersede(Headers, Supersede, FirstPair, SecondPair) of
|
||||
true ->
|
||||
Module:send(Socket, ?TWO_OK);
|
||||
false ->
|
||||
Module:send(Socket, ?FOUR_BAD_REQUEST)
|
||||
end
|
||||
end
|
||||
end.
|
||||
|
||||
build_cookie(N, V) ->
|
||||
binary_to_list(<<N/binary,"=",V/binary>>).
|
||||
|
||||
check_cookie_deleted(Headers, true, _) ->
|
||||
undefined == proplists:get_value("Cookie", Headers);
|
||||
check_cookie_deleted(Headers, false, {_, {{N, V}, _}}) ->
|
||||
build_cookie(N, V) == proplists:get_value("Cookie", Headers).
|
||||
|
||||
%% http://tools.ietf.org/search/rfc6265#section-4.1.2
|
||||
check_cookie_supersede(Headers, true, {Name, _, _, _}, {_, NewValue, _, _}) ->
|
||||
build_cookie(Name, NewValue) == proplists:get_value("Cookie", Headers);
|
||||
check_cookie_supersede(Headers, false, {Name, Value, Path, _},
|
||||
{NewName, NewValue, Path, _}) ->
|
||||
lists:sort([build_cookie(Name, Value), build_cookie(NewName, NewValue)])
|
||||
== lists:sort(string:tokens(proplists:get_value("Cookie", Headers), "; "));
|
||||
check_cookie_supersede(Headers, false, {Name, Value, _, _}, _) ->
|
||||
build_cookie(Name, Value)
|
||||
== proplists:get_value("Cookie", Headers).
|
||||
|
||||
verify_host(GotHeaders, SentHeaders) ->
|
||||
%% Host must be added by the client if it is not part of the headers list
|
||||
%% http://tools.ietf.org/html/rfc2616#section-14.23
|
||||
Key = "host",
|
||||
case lists:keytake(Key, 1, GotHeaders) of
|
||||
{value, {_, Value}, NewGotHeaders} ->
|
||||
case lists:keytake(Key, 1, SentHeaders) of
|
||||
%% The user sent the 'Host' header, value must match
|
||||
{value, {_, Value}, NewSentHeaders} ->
|
||||
{NewGotHeaders, NewSentHeaders};
|
||||
false ->
|
||||
{NewGotHeaders, SentHeaders};
|
||||
_ ->
|
||||
false
|
||||
end;
|
||||
false ->
|
||||
false
|
||||
end.
|
||||
|
||||
verify_content_length(Body, GotHeaders, SentHeaders) ->
|
||||
%% Must be updated when the code supports transfer-encoding
|
||||
%% http://tools.ietf.org/html/rfc2616#section-14.13
|
||||
Key = "content-length",
|
||||
ContentLength = iolist_size(Body),
|
||||
{NewGotHeaders, GotContentLength}
|
||||
= case lists:keytake(Key, 1, GotHeaders) of
|
||||
{value, {_, Value}, H} ->
|
||||
{H, list_to_integer(Value)};
|
||||
false ->
|
||||
{GotHeaders, 0}
|
||||
end,
|
||||
case ContentLength == GotContentLength of
|
||||
true ->
|
||||
{NewGotHeaders, lists:keydelete(Key, 1, SentHeaders)};
|
||||
false ->
|
||||
false
|
||||
end.
|
||||
|
||||
validate_headers(Body, GotHeaders, SentHeaders) ->
|
||||
CleanGotHeaders = lists:keysort(1, [{string:to_lower(K), V}
|
||||
|| {K, V} <- GotHeaders]),
|
||||
CleanSentHeaders = lists:keysort(1, [{string:to_lower(binary_to_list(K)),
|
||||
binary_to_list(V)}
|
||||
|| {K, V} <- SentHeaders]),
|
||||
case verify_host(CleanGotHeaders, CleanSentHeaders) of
|
||||
false ->
|
||||
false;
|
||||
{GotHeaders1, Headers1} ->
|
||||
case verify_content_length(Body, GotHeaders1, Headers1) of
|
||||
false ->
|
||||
false;
|
||||
{GotHeaders2, Headers2} ->
|
||||
GotHeaders2 == Headers2
|
||||
end
|
||||
end.
|
||||
|
||||
reply_msg(Msg) ->
|
||||
fun(Module, Socket, _Request, _Headers, _Body) ->
|
||||
Module:send(Socket, Msg)
|
||||
end.
|
||||
|
||||
reply_msg_and_check(Id, Msg) ->
|
||||
Parent = self(),
|
||||
fun(Module, Socket, _Request, _Headers, _Body) ->
|
||||
Module:send(Socket, Msg),
|
||||
case Module:recv(Socket, 0) of
|
||||
{error, closed} ->
|
||||
Parent ! {Id, closed};
|
||||
_ ->
|
||||
ok
|
||||
end
|
||||
end.
|
||||
|
||||
reply_and_close_msg(Msg) ->
|
||||
fun(Module, Socket, _Request, _Headers, _Body) ->
|
||||
Module:send(Socket, Msg),
|
||||
Module:close(Socket)
|
||||
end.
|
||||
|
||||
must_close(Headers, Connection) ->
|
||||
case proplists:get_value(<<"Connection">>, Headers) of
|
||||
<<"close">> ->
|
||||
true;
|
||||
_ ->
|
||||
case Connection of
|
||||
<<"close">> ->
|
||||
true;
|
||||
_ ->
|
||||
false
|
||||
end
|
||||
end.
|
||||
|
||||
select_module(Ssl) ->
|
||||
case Ssl of
|
||||
true ->
|
||||
ssl;
|
||||
false ->
|
||||
gen_tcp
|
||||
end.
|
||||
|
||||
encode_path(Path) ->
|
||||
case lists:split(length(Path) - 1, Path) of
|
||||
{P, ["/"]} ->
|
||||
list_to_binary(["/", string:join(P, "/"), "/"]);
|
||||
_ ->
|
||||
list_to_binary(["/", string:join(Path, "/")])
|
||||
end.
|
||||
|
||||
build_response({StatusLine, Headers, Body}, Cookies) ->
|
||||
http_eqc_encoding:build_valid_response(
|
||||
StatusLine,
|
||||
http_eqc_encoding:add_content_length(Headers, Body),
|
||||
Cookies, Body).
|
||||
|
||||
send_cookie_requests(Host, Ssl, Family, ValidationFun, Path,
|
||||
{{Method, _Uri, _Version}, Headers, Body},
|
||||
RequestTags, WaitTime) ->
|
||||
Module = select_module(Ssl),
|
||||
{ok, Listener, LS, Port} =
|
||||
webserver:start(Module, [ValidationFun], Family),
|
||||
{ok, Client} = fusco:start({Host, Port, Ssl}, [{use_cookies, true}]),
|
||||
%% Use header "test" to distinguish requests in the server side
|
||||
Responses = lists:map(
|
||||
fun(Header) ->
|
||||
{ok, {Response, _, _, _, _}}
|
||||
= fusco:request(Client, Path, Method,
|
||||
[{<<"test">>, Header} | Headers],
|
||||
Body, 10000),
|
||||
timer:sleep(WaitTime),
|
||||
Response
|
||||
end, RequestTags),
|
||||
ok = fusco:disconnect(Client),
|
||||
webserver:stop(Module, Listener, LS),
|
||||
Responses.
|
||||
|
||||
expiration_time(Expires, MaxAge) ->
|
||||
case Expires of
|
||||
true ->
|
||||
MaxAge*1000;
|
||||
false ->
|
||||
0
|
||||
end.
|
||||
|
||||
check_responses(Status, Reason, [First, Second]) ->
|
||||
Expected = {Status, Reason},
|
||||
?WHENFAIL(io:format("First: ~p~nExpected: ~p~nSecond: ~p~n",
|
||||
[First, Expected, Second]),
|
||||
{First, Second} == {Expected, {<<"200">>, <<"OK">>}}
|
||||
);
|
||||
check_responses(Status, Reason, [First, Second, Third]) ->
|
||||
Expected = {Status, Reason},
|
||||
?WHENFAIL(io:format("First: ~p~nSecond: ~p~nExpected: ~p~nThird ~p~n",
|
||||
[First, Second, Expected, Third]),
|
||||
{First, Second, Third}
|
||||
== {Expected, Expected, {<<"200">>, <<"OK">>}}
|
||||
).
|
||||
|
||||
diff(A, A) ->
|
||||
eq;
|
||||
diff(A, B) when A < B ->
|
||||
lt;
|
||||
diff(_, _) ->
|
||||
gt.
|
||||
|
||||
is_past(DateTime) ->
|
||||
{Date, {H, M, _}} = http_eqc_encoding:expires_datetime(DateTime),
|
||||
case diff(Date, date()) of
|
||||
lt ->
|
||||
true;
|
||||
gt ->
|
||||
false;
|
||||
eq ->
|
||||
{HH, MM, _} = time(),
|
||||
%% Set 30 min margin, safe side
|
||||
case diff((HH*60+MM) - (H*60+M), 30) of
|
||||
gt ->
|
||||
true;
|
||||
eq ->
|
||||
true;
|
||||
lt ->
|
||||
false
|
||||
end
|
||||
end.
|
||||
|
||||
is_future(DateTime) ->
|
||||
{Date, {H, M, _}} = http_eqc_encoding:expires_datetime(DateTime),
|
||||
case diff(Date, date()) of
|
||||
gt ->
|
||||
true;
|
||||
lt ->
|
||||
false;
|
||||
eq ->
|
||||
{HH, MM, _} = time(),
|
||||
%% Set 30 min margin, safe side
|
||||
case diff((H*60+M) - (HH*60+MM), 30) of
|
||||
gt ->
|
||||
true;
|
||||
eq ->
|
||||
true;
|
||||
lt ->
|
||||
false
|
||||
end
|
||||
end.
|
||||
|
|
@ -0,0 +1,153 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2014, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(http_eqc_encoding).
|
||||
-copyright("2014, Erlang Solutions Ltd.").
|
||||
|
||||
-export([add_content_length/2,
|
||||
add_transfer_encoding/2,
|
||||
body/1]).
|
||||
|
||||
-export([build_valid_response/4,
|
||||
build_cookie/1,
|
||||
build_expires_date/1,
|
||||
expires_datetime/1]).
|
||||
|
||||
%%==============================================================================
|
||||
%% API
|
||||
%%==============================================================================
|
||||
add_content_length(Headers, <<>>) ->
|
||||
Headers;
|
||||
add_content_length(Headers, Body) ->
|
||||
ContentLength = list_to_binary(integer_to_list(byte_size(Body))),
|
||||
[{<<"Content-Length">>, ContentLength} | Headers].
|
||||
|
||||
body({_, <<$1, _, _>>, _}) ->
|
||||
<<>>;
|
||||
body({_, <<$2,$0,$4>>, _}) ->
|
||||
<<>>;
|
||||
body({_, <<$3,$0,$4>>, _}) ->
|
||||
<<>>;
|
||||
body(_) ->
|
||||
http_eqc_gen:body().
|
||||
|
||||
add_transfer_encoding(Headers, <<>>) ->
|
||||
Headers;
|
||||
add_transfer_encoding(Headers, Encoding) ->
|
||||
lists:keystore(<<"Transfer-Encoding">>, 1,
|
||||
remove_transfer_encoding(Headers),
|
||||
{<<"Transfer-Encoding">>, Encoding}).
|
||||
|
||||
build_valid_response({HttpVersion, StatusCode, Reason}, Headers, Cookies, Body) ->
|
||||
SL = [HttpVersion, sp(), StatusCode, sp(), Reason, crlf()],
|
||||
HS = [[Name, colon(), Value, crlf()] || {Name, Value} <- Headers],
|
||||
CS = [[Name, colon(), build_cookie(Cookie), crlf()] || {Name, Cookie} <- Cookies],
|
||||
[SL, HS ++ CS, crlf(), build_body(Body)].
|
||||
|
||||
build_cookie({{K, V}, Avs}) ->
|
||||
CookiePair = [K, eq(), V],
|
||||
CookieAvs = build_cookie_avs(Avs),
|
||||
CookiePair ++ CookieAvs.
|
||||
|
||||
build_expires_date({rfc1123date, {Wkday, Date1, Time}}) ->
|
||||
Date = build_date(Date1),
|
||||
BTime = build_time(Time),
|
||||
[Wkday, $,, $\s, Date, $\s, BTime, $\s, "GMT"];
|
||||
build_expires_date({rfc850date, {Weekday, Date2, Time}}) ->
|
||||
Date = build_date(Date2),
|
||||
BTime = build_time(Time),
|
||||
[Weekday, $,, $\s, Date, $\s, BTime, $\s, "GMT"];
|
||||
build_expires_date({asctimedate, {Wkday, Date3, Time, Year}}) ->
|
||||
BTime = build_time(Time),
|
||||
Date = build_date(Date3),
|
||||
[Wkday, $\s, Date, $\s, BTime, $\s, Year].
|
||||
|
||||
expires_datetime({rfc1123date, {_, {date1, {Day, Month, Year}}, {H, M, S}}}) ->
|
||||
{{st_to_int(Year), month(Month), st_to_int(Day)},
|
||||
{st_to_int(H), st_to_int(M), st_to_int(S)}};
|
||||
expires_datetime({rfc850date, {_, {date2, {Day, Month, Year}}, {H, M, S}}}) ->
|
||||
{{to_year(Year), month(Month), st_to_int(Day)},
|
||||
{st_to_int(H), st_to_int(M), st_to_int(S)}};
|
||||
expires_datetime({asctimedate, {_, {date3, {Day, Month}}, {H, M, S}, Year}}) ->
|
||||
{{st_to_int(Year), month(Month), st_to_int(Day)},
|
||||
{st_to_int(H), st_to_int(M), st_to_int(S)}};
|
||||
expires_datetime(undefined) ->
|
||||
undefined.
|
||||
%%==============================================================================
|
||||
%% Internal functions
|
||||
%%==============================================================================
|
||||
remove_transfer_encoding(Headers) ->
|
||||
lists:filter(fun({H, _}) -> H =/= <<"Transfer-Encoding">> end, Headers).
|
||||
|
||||
build_body(Body) when is_binary(Body) ->
|
||||
Body;
|
||||
build_body(List) ->
|
||||
list_to_binary(
|
||||
io_lib:format("~s0\r\n\r\n",
|
||||
[[io_lib:format("~s\r\n~s\r\n",
|
||||
[erlang:integer_to_list(Nat, 16), Body])
|
||||
|| {Nat, Body} <- List]])).
|
||||
|
||||
build_cookie_avs(Avs) ->
|
||||
build_cookie_avs(Avs, []).
|
||||
|
||||
build_cookie_avs([{<<"Expires">> = K, Date} | Rest], Acc) ->
|
||||
V = build_expires_date(Date),
|
||||
build_cookie_avs(Rest, [[semicolon(), sp(), K, eq(), V] | Acc]);
|
||||
build_cookie_avs([{K, V} | Rest], Acc) ->
|
||||
build_cookie_avs(Rest, [[semicolon(), sp(), K, eq(), V] | Acc]);
|
||||
build_cookie_avs([K | Rest], Acc) ->
|
||||
build_cookie_avs(Rest, [[semicolon(), sp(), K] | Acc]);
|
||||
build_cookie_avs([], Acc) ->
|
||||
Acc.
|
||||
|
||||
build_date({date1, {Day, Month, Year}}) ->
|
||||
[Day, $\s, Month, $\s, Year];
|
||||
build_date({date2, {Day, Month, Year}}) ->
|
||||
[Day, $-, Month, $-, Year];
|
||||
build_date({date3, {Day, Month}}) ->
|
||||
[Month, $\s, Day].
|
||||
|
||||
build_time({H, M, S}) ->
|
||||
[H, $:, M, $:, S].
|
||||
|
||||
colon() ->
|
||||
<<$:>>.
|
||||
|
||||
semicolon() ->
|
||||
<<$;>>.
|
||||
|
||||
sp() ->
|
||||
<<$\s>>.
|
||||
|
||||
crlf() ->
|
||||
<<$\r,$\n>>.
|
||||
|
||||
eq() ->
|
||||
<<$=>>.
|
||||
|
||||
months() ->
|
||||
[{"Jan", 1}, {"Feb", 2}, {"Mar", 3}, {"Apr", 4},
|
||||
{"May", 5}, {"Jun", 6}, {"Jul", 7}, {"Aug", 8},
|
||||
{"Sep", 9}, {"Oct", 10}, {"Nov", 11}, {"Dec", 12}].
|
||||
|
||||
st_to_int(L) ->
|
||||
list_to_integer(L).
|
||||
|
||||
month(Month) ->
|
||||
proplists:get_value(Month, months()).
|
||||
|
||||
to_year(Year) when length(Year) == 4 ->
|
||||
st_to_int(Year);
|
||||
to_year(Year) ->
|
||||
IntY = list_to_integer(Year),
|
||||
{Y, _, _} = date(),
|
||||
case (2000 + IntY - Y) > 50 of
|
||||
true ->
|
||||
1900 + IntY;
|
||||
false ->
|
||||
2000 + IntY
|
||||
end.
|
||||
|
|
@ -0,0 +1,262 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc Quickcheck generators for HTTP messages
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(http_eqc_gen).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-include_lib("eqc/include/eqc.hrl").
|
||||
|
||||
-compile(export_all).
|
||||
|
||||
%% RFC 2616
|
||||
general_header() ->
|
||||
[{<<"Cache-Control">>, small_valid_bin()},
|
||||
{<<"Connection">>, connection_header()},
|
||||
{<<"Date">>, small_valid_bin()},
|
||||
{<<"Pragma">>, small_valid_bin()},
|
||||
{<<"Trailer">>, small_valid_bin()},
|
||||
{<<"Transfer-Encoding">>, small_valid_bin()},
|
||||
{<<"Upgrade">>, small_valid_bin()},
|
||||
{<<"Via">>, small_valid_bin()},
|
||||
{<<"Warning">>, small_valid_bin()}].
|
||||
|
||||
connection_header() ->
|
||||
oneof([<<"close">>, <<"keep-alive">>, small_valid_bin()]).
|
||||
|
||||
%% RFC 2616
|
||||
entity_header() ->
|
||||
[{<<"Allow">>, small_valid_bin()},
|
||||
{<<"Content-Encoding">>, small_valid_bin()},
|
||||
{<<"Content-Language">>, small_valid_bin()},
|
||||
{<<"Content-Location">>, small_valid_bin()},
|
||||
{<<"Content-MD5">>, small_valid_bin()},
|
||||
{<<"Content-Range">>, small_valid_bin()},
|
||||
{<<"Content-Type">>, small_valid_bin()},
|
||||
{<<"Expires">>, small_valid_bin()},
|
||||
{<<"Last-Modified">>, small_valid_bin()}].
|
||||
|
||||
%% RFC 2616
|
||||
response_header() ->
|
||||
[{<<"Accept-Ranges">>, small_valid_bin()},
|
||||
{<<"Age">>, small_valid_bin()},
|
||||
{<<"ETag">>, small_valid_bin()},
|
||||
{<<"Location">>, small_valid_bin()},
|
||||
{<<"Proxy-Authenticate">>, small_valid_bin()},
|
||||
{<<"Retry-After">>, small_valid_bin()},
|
||||
{<<"Server">>, small_valid_bin()},
|
||||
{<<"Vary">>, small_valid_bin()},
|
||||
{<<"WWW-Authenticate">>, small_valid_bin()}].
|
||||
|
||||
%% http://tools.ietf.org/html/rfc2616#section-5.3
|
||||
request_header() ->
|
||||
[{<<"Accept">>, small_valid_bin()},
|
||||
{<<"Accept-Charset">>, small_valid_bin()},
|
||||
{<<"Accept-Encoding">>, small_valid_bin()},
|
||||
{<<"Accept-Language">>, small_valid_bin()},
|
||||
{<<"Authorization">>, authorization()},
|
||||
{<<"Expect">>, small_valid_bin()},
|
||||
{<<"From">>, small_valid_bin()},
|
||||
{<<"Host">>, small_valid_bin()},
|
||||
{<<"If-Match">>, small_valid_bin()},
|
||||
{<<"If-Modified-Since">>, small_valid_bin()},
|
||||
{<<"If-None-Match">>, small_valid_bin()},
|
||||
{<<"If-Range">>, small_valid_bin()},
|
||||
{<<"If-Unmodified-Since">>, small_valid_bin()},
|
||||
{<<"Max-Forwards">>, small_valid_bin()},
|
||||
{<<"Proxy-Authorization">>, small_valid_bin()},
|
||||
{<<"Range">>, small_valid_bin()},
|
||||
{<<"Referer">>, small_valid_bin()},
|
||||
{<<"TE">>, small_valid_bin()},
|
||||
{<<"User-Agent">>, small_valid_bin()}
|
||||
].
|
||||
|
||||
authorization() ->
|
||||
?LET({User, Pass}, {small_valid_bin(), small_valid_bin()},
|
||||
begin
|
||||
Encoded = base64:encode(<<User/binary, $:, Pass/binary>>),
|
||||
<<"Basic ", Encoded/binary>>
|
||||
end).
|
||||
|
||||
header() ->
|
||||
lists:append([general_header(), entity_header(), response_header()]).
|
||||
|
||||
req_headers() ->
|
||||
lists:append([general_header(), entity_header(), request_header()]).
|
||||
|
||||
request_headers() ->
|
||||
?LET(Headers, list(oneof(req_headers())), Headers).
|
||||
|
||||
headers() ->
|
||||
?LET(Headers, list(oneof(header())), Headers).
|
||||
|
||||
http_version() ->
|
||||
[<<"HTTP/1.0">>, <<"HTTP/1.1">>].
|
||||
|
||||
informational_code() ->
|
||||
[{<<"100">>, <<"Continue">>},
|
||||
{<<"101">>, <<"Switching protocols">>}].
|
||||
|
||||
success_code() ->
|
||||
[{<<"200">>, <<"OK">>},
|
||||
{<<"201">>, <<"Created">>},
|
||||
{<<"202">>, <<"Accepted">>},
|
||||
{<<"203">>, <<"Non-Authoritative Information">>},
|
||||
{<<"204">>, <<"No Content">>},
|
||||
{<<"205">>, <<"Reset Content">>},
|
||||
{<<"206">>, <<"Partial Content">>}].
|
||||
|
||||
redirection_code() ->
|
||||
[{<<"300">>, <<"Multiple Choices">>},
|
||||
{<<"301">>, <<"Moved Permanently">>},
|
||||
{<<"302">>, <<"Found">>},
|
||||
{<<"303">>, <<"See Other">>},
|
||||
{<<"304">>, <<"Not Modified">>},
|
||||
{<<"305">>, <<"Use Proxy">>},
|
||||
{<<"307">>, <<"Temporary Redirect">>}].
|
||||
|
||||
client_error_code() ->
|
||||
[{<<"400">>, <<"Bad Request">>},
|
||||
{<<"401">>, <<"Unauthorized">>},
|
||||
{<<"402">>, <<"Payment Required">>},
|
||||
{<<"403">>, <<"Forbidden">>},
|
||||
{<<"404">>, <<"Not Found">>},
|
||||
{<<"405">>, <<"Method Not Allowed">>},
|
||||
{<<"406">>, <<"Not Acceptable">>},
|
||||
{<<"407">>, <<"Proxy Authentication Required">>},
|
||||
{<<"408">>, <<"Request Time-out">>},
|
||||
{<<"409">>, <<"Conflict">>},
|
||||
{<<"410">>, <<"Gone">>},
|
||||
{<<"411">>, <<"Length Required">>},
|
||||
{<<"412">>, <<"Precondition Failed">>},
|
||||
{<<"413">>, <<"Request Entity Too Large">>},
|
||||
{<<"414">>, <<"Request-URI Too Large">>},
|
||||
{<<"415">>, <<"Unsupported Media Type">>},
|
||||
{<<"416">>, <<"Requested range not satisfiable">>},
|
||||
{<<"417">>, <<"Expectation Failed">>}].
|
||||
|
||||
server_error_code() ->
|
||||
[{<<"500">>, <<"Internal Server Error">>},
|
||||
{<<"501">>, <<"Not Implemented">>},
|
||||
{<<"502">>, <<"Bad Gateway">>},
|
||||
{<<"503">>, <<"Service Unavailable">>},
|
||||
{<<"504">>, <<"Gateway Time-out">>},
|
||||
{<<"505">>, <<"HTTP Version not supported">>}].
|
||||
|
||||
%% RFC 6265
|
||||
set_cookie() ->
|
||||
{<<"Set-Cookie">>, set_cookie_string()}.
|
||||
|
||||
set_cookie_string() ->
|
||||
{cookie_pair(), cookie_avs()}.
|
||||
|
||||
cookie_pair() ->
|
||||
{small_valid_bin(), small_valid_bin()}.
|
||||
|
||||
cookie_avs() ->
|
||||
list(oneof(cookie_av())).
|
||||
|
||||
cookie_av() ->
|
||||
[{<<"Expires">>, sane_cookie_date()},
|
||||
{<<"Max-Age">>, max_age()},
|
||||
{<<"Domain">>, small_valid_bin()},
|
||||
{<<"Path">>, small_valid_bin()},
|
||||
{<<"Secure">>, small_valid_bin()},
|
||||
<<"HttpOnly">>,
|
||||
small_valid_bin() %% extension
|
||||
].
|
||||
|
||||
sane_cookie_date() ->
|
||||
?LET(Date, oneof([rfc1123date(), rfc850date(), asctimedate()]), Date).
|
||||
|
||||
max_age() ->
|
||||
?LET(Age, ?SUCHTHAT(Nat, nat(), Nat > 0), list_to_binary(integer_to_list(Age))).
|
||||
|
||||
rfc1123date() ->
|
||||
{rfc1123date, {wkday(), date1(), timeb()}}.
|
||||
|
||||
rfc850date() ->
|
||||
{rfc850date, {weekday(), date2(), timeb()}}.
|
||||
|
||||
asctimedate() ->
|
||||
{asctimedate, {wkday(), date3(), timeb(), year4()}}.
|
||||
|
||||
date1() ->
|
||||
{date1, {day(), month(), year4()}}.
|
||||
|
||||
date2() ->
|
||||
{date2, {day(), month(), year2()}}.
|
||||
|
||||
date3() ->
|
||||
{date3, {day(), month()}}.
|
||||
|
||||
timeb() ->
|
||||
?LET({H, M, S}, {choose(0, 23), choose(0,59), choose(0, 59)},
|
||||
{twod(H), twod(M), twod(S)}).
|
||||
|
||||
twod(Integer) ->
|
||||
string:right(integer_to_list(Integer), 2, $0).
|
||||
|
||||
day() ->
|
||||
?LET(Day, choose(1, 31), twod(Day)).
|
||||
|
||||
year4() ->
|
||||
?LET(Year, choose(1983, 2083), integer_to_list(Year)).
|
||||
|
||||
year2() ->
|
||||
?LET(Year, choose(0, 99), twod(Year)).
|
||||
|
||||
wkday() ->
|
||||
?LET(Wkday, oneof(["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"]), Wkday).
|
||||
|
||||
weekday() ->
|
||||
?LET(Weekday, oneof(["Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
|
||||
"Saturday", "Sunday"]),
|
||||
Weekday).
|
||||
|
||||
month() ->
|
||||
?LET(Month,
|
||||
oneof(["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep",
|
||||
"Oct", "Nov", "Dec"]),
|
||||
Month).
|
||||
|
||||
status_code() ->
|
||||
lists:append([informational_code(), success_code(), redirection_code(),
|
||||
client_error_code(), server_error_code()]).
|
||||
|
||||
status_line() ->
|
||||
?LET({HttpVersion, {StatusCode, Reason}},
|
||||
{oneof(http_version()), oneof(status_code())},
|
||||
{HttpVersion, StatusCode, Reason}).
|
||||
|
||||
http_method() ->
|
||||
["OPTIONS", "GET", "HEAD", "POST", "PUT", "DELETE", "TRACE", "CONNECT"].
|
||||
|
||||
request_uri() ->
|
||||
[<<"*">>, <<"http://www.w3.org/pub/WWW/TheProject.html">>,
|
||||
<<"/pub/WWW/TheProject.html">>].
|
||||
|
||||
request_line() ->
|
||||
?LET({Method, RequestUri},
|
||||
{oneof(http_method()), oneof(request_uri())},
|
||||
{Method, RequestUri, "HTTP/1.1"}).
|
||||
|
||||
small_valid_bin() ->
|
||||
?LET(String, vector(5, choose($A, $z)),
|
||||
list_to_binary(String)).
|
||||
|
||||
body() ->
|
||||
?LET(String, list(choose($A, $z)),
|
||||
list_to_binary(String)).
|
||||
|
||||
body(Size) ->
|
||||
?LET(String, vector(Size, choose($A, $z)), String).
|
||||
|
||||
chunked_body() ->
|
||||
?LET(PosNats, non_empty(list(?SUCHTHAT(Nat, nat(), Nat > 0))),
|
||||
?LET(Bins, [body(Size) || Size <- PosNats],
|
||||
lists:zip(PosNats, Bins)
|
||||
)
|
||||
).
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
-----BEGIN RSA PRIVATE KEY-----
|
||||
MIICXQIBAAKBgQC6YrA5HIBj817qplKlRaU3dkCnnZtKS666lRbqsdj3Fug7ezAN
|
||||
mUrUZIGMTDOAwYg3E2JPAL1VOiPmi/ENlanLTyOp2SkqYLfR59Z5wr1nE/iAC+es
|
||||
7WT2OPjXG7MIBvnM7FNpHY17F4MM0FWWm+LJyJRucUZHL964nw0c2xZ3fwIDAQAB
|
||||
AoGAWpvnd5w3fl+t4P0CaH43F4NRYyrnd3LberFH9siG5XgpZeE5NyMykZZatE3H
|
||||
K+zpv3yY6jc909Tz5vxZL3V2mR5r5O8PulteyZ8gHKVMD3c//xhPjcVMOg2j/wB1
|
||||
QLDvL8qL7tDv53uYKyy3fVud9ao8xbNtoL+pzpMGE3CdlqECQQDxTyrQ0OE9+/1Q
|
||||
xM0Oa7b48R3ncL/zv5sXB7Melr2j27CIxm04DXi9CnWVYMvlgWYZ5nBBMOZixTZA
|
||||
YSq7tkmFAkEAxbuHNGeCSffccv5LsVMIHLRYZr/WBRqkbim8K76XaSD/ao9BR/T/
|
||||
ZobOiYTD36eKw4TzKXfKkMiHcPyRGb4qMwJBAIXFmHu4QBWnmy9qWi7TYdSxfh1u
|
||||
cMsEfkqPFyou8KRkxoGcVrHLLhLGOJb92Sq6yEo1aCeLnzxEDaY094amMC0CQQCo
|
||||
JlVQJ0YRCQsbb02HOokHgAY9Op4SMRnr5On0eVvhNwJ9590oCBy5X6J8J786jwve
|
||||
QU1X0lsczKsBVoc+UQ0pAkBO/+utKl2jt0LYHi+ZOsvLgLoYKy7y+304MsId3Hfi
|
||||
oZpxA0a5ctG1tHpBAjJJfO1at4Dpy67nkQNc3CAhrsSn
|
||||
-----END RSA PRIVATE KEY-----
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
%%%=============================================================================
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc
|
||||
%%% @end
|
||||
%%%=============================================================================
|
||||
-module(test_utils).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-export([start_listener/1,
|
||||
start_listener/2,
|
||||
send_message/1,
|
||||
stop_listener/1]).
|
||||
|
||||
start_listener(Msg) ->
|
||||
start_listener(Msg, close).
|
||||
|
||||
start_listener({fragmented, Msg}, ConnectionState) ->
|
||||
random:seed(erlang:now()),
|
||||
start_listener(Msg, fun fragmented_user_response/1, ConnectionState);
|
||||
start_listener(Msg, ConnectionState) ->
|
||||
start_listener(Msg, fun user_response/1, ConnectionState).
|
||||
|
||||
start_listener(Msg, Fun, ConnectionState) ->
|
||||
Responders = case ConnectionState of
|
||||
close ->
|
||||
[Fun(Msg)];
|
||||
keepalive ->
|
||||
[Fun(Msg), user_response(message())]
|
||||
end,
|
||||
{ok, Listener, LS, Port} = webserver:start(gen_tcp, Responders),
|
||||
{ok, Socket} = gen_tcp:connect("127.0.0.1", Port, [binary, {packet, raw},
|
||||
{nodelay, true},
|
||||
{reuseaddr, true},
|
||||
{active, false}], 5000),
|
||||
{Listener, LS, Socket}.
|
||||
|
||||
send_message(Socket) ->
|
||||
gen_tcp:send(Socket, message()).
|
||||
|
||||
|
||||
send_fragmented_message(Module, Socket, L) when is_list(L) ->
|
||||
send_fragmented_message(Module, Socket, list_to_binary(L));
|
||||
send_fragmented_message(_, _, <<>>) ->
|
||||
ok;
|
||||
send_fragmented_message(Module, Socket, Msg) ->
|
||||
Length = erlang:byte_size(Msg),
|
||||
R = random(Length),
|
||||
Bin = binary:part(Msg, 0, R),
|
||||
Module:send(Socket, Bin),
|
||||
send_fragmented_message(Module, Socket, binary:part(Msg, R, erlang:byte_size(Msg) - R)).
|
||||
|
||||
random(Length) when Length =< 5 ->
|
||||
random:uniform(Length);
|
||||
random(_Length) ->
|
||||
random:uniform(5).
|
||||
|
||||
user_response(Message) ->
|
||||
fun(Module, Socket, _, _, _) ->
|
||||
Module:send(Socket, Message)
|
||||
end.
|
||||
|
||||
fragmented_user_response(Message) ->
|
||||
fun(Module, Socket, _, _, _) ->
|
||||
send_fragmented_message(Module, Socket, Message)
|
||||
end.
|
||||
|
||||
message() ->
|
||||
<<"GET /blabla HTTP/1.1\r\nhost: 127.0.0.1:5050\r\nuser-agent: Cow\r\nAccept: */*\r\n\r\n">>.
|
||||
|
||||
stop_listener({Listener, LS, Socket}) ->
|
||||
webserver:stop(Listener, LS),
|
||||
gen_tcp:close(Socket).
|
||||
|
|
@ -0,0 +1,147 @@
|
|||
%%%-----------------------------------------------------------------------------
|
||||
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
|
||||
%%% @author Oscar Hellström <oscar@hellstrom.st>
|
||||
%%% @author Magnus Henoch <magnus@erlang-consulting.com>
|
||||
%%% @author Diana Parra Corbacho <diana.corbacho@erlang-solutions.com>
|
||||
%%% @doc Simple web server for testing purposes
|
||||
%%% @end
|
||||
%%%-----------------------------------------------------------------------------
|
||||
-module(webserver).
|
||||
-copyright("2013, Erlang Solutions Ltd.").
|
||||
|
||||
-export([start/2, start/3, stop/2, stop/3]).
|
||||
-export([acceptor/3]).
|
||||
|
||||
start(Module, Responders) ->
|
||||
start(Module, Responders, inet).
|
||||
|
||||
start(Module, Responders, Family) ->
|
||||
case get_addr("localhost", Family) of
|
||||
{ok, Addr} ->
|
||||
LS = listen(Module, Addr, Family),
|
||||
Pid = spawn(?MODULE, acceptor, [Module, LS, Responders]),
|
||||
{ok, Pid, LS, port(Module, LS)};
|
||||
Error ->
|
||||
Error
|
||||
end.
|
||||
|
||||
stop(Listener, LS) ->
|
||||
stop(gen_tcp, Listener, LS).
|
||||
|
||||
stop(Module, Listener, LS) ->
|
||||
(catch exit(kill, Listener)),
|
||||
Module:close(LS).
|
||||
|
||||
acceptor(Module, ListenSocket, Responders) ->
|
||||
case accept(Module, ListenSocket) of
|
||||
error ->
|
||||
ok;
|
||||
Socket ->
|
||||
spawn_link(fun() ->
|
||||
acceptor(Module, ListenSocket, Responders)
|
||||
end),
|
||||
server_loop(Module, Socket, nil, [], Responders)
|
||||
end.
|
||||
|
||||
server_loop(Module, Socket, _, _, []) ->
|
||||
Module:close(Socket);
|
||||
server_loop(Module, Socket, Request, Headers, [H | T] = Responders) ->
|
||||
receive
|
||||
stop ->
|
||||
Module:close(Socket)
|
||||
after 0 ->
|
||||
case Module:recv(Socket, 0, 500) of
|
||||
{ok, {http_request, _, _, _} = NewRequest} ->
|
||||
server_loop(Module, Socket, NewRequest, Headers, Responders);
|
||||
{ok, {http_header, _, Field, _, Value}} when is_atom(Field) ->
|
||||
NewHeaders = [{atom_to_list(Field), Value} | Headers],
|
||||
server_loop(Module, Socket, Request, NewHeaders, Responders);
|
||||
{ok, {http_header, _, Field, _, Value}} when is_list(Field) ->
|
||||
NewHeaders = [{Field, Value} | Headers],
|
||||
server_loop(Module, Socket, Request, NewHeaders, Responders);
|
||||
{ok, http_eoh} ->
|
||||
RequestBody = case proplists:get_value("Content-Length", Headers) of
|
||||
undefined ->
|
||||
<<>>;
|
||||
"0" ->
|
||||
<<>>;
|
||||
SLength ->
|
||||
Length = list_to_integer(SLength),
|
||||
setopts(Module, Socket, [{packet, raw}]),
|
||||
{ok, Body} = Module:recv(Socket, Length),
|
||||
setopts(Module, Socket, [{packet, http}]),
|
||||
Body
|
||||
end,
|
||||
H(Module, Socket, Request, Headers, RequestBody),
|
||||
case proplists:get_value("Connection", Headers) of
|
||||
"close" ->
|
||||
Module:close(Socket);
|
||||
_ ->
|
||||
server_loop(Module, Socket, none, [], T)
|
||||
end;
|
||||
{error, timeout} ->
|
||||
server_loop(Module, Socket, Request, Headers, Responders);
|
||||
{error, closed} ->
|
||||
Module:close(Socket)
|
||||
end
|
||||
end.
|
||||
|
||||
listen(ssl, Addr, Family) ->
|
||||
Root = code:lib_dir(fusco, test),
|
||||
Opts = [
|
||||
Family,
|
||||
{packet, http},
|
||||
binary,
|
||||
{active, false},
|
||||
{ip, Addr},
|
||||
{verify,0},
|
||||
{keyfile, filename:join(Root, "key.pem")},
|
||||
{certfile, filename:join(Root,"crt.pem")}
|
||||
],
|
||||
{ok, LS} = ssl:listen(0, Opts),
|
||||
LS;
|
||||
listen(Module, Addr, Family) ->
|
||||
{ok, LS} = Module:listen(0, [
|
||||
Family,
|
||||
{packet, http},
|
||||
binary,
|
||||
{active, false},
|
||||
{ip, Addr}
|
||||
]),
|
||||
LS.
|
||||
|
||||
get_addr(Host, Family) ->
|
||||
case inet:getaddr(Host, Family) of
|
||||
{ok, Addr} ->
|
||||
{ok, Addr};
|
||||
_ ->
|
||||
{error, family_not_supported}
|
||||
end.
|
||||
|
||||
accept(ssl, ListenSocket) ->
|
||||
case ssl:transport_accept(ListenSocket, 1000000) of
|
||||
{ok, Socket} ->
|
||||
ok = ssl:ssl_accept(Socket),
|
||||
Socket;
|
||||
{error, _} ->
|
||||
error
|
||||
end;
|
||||
accept(Module, ListenSocket) ->
|
||||
case Module:accept(ListenSocket, 100000) of
|
||||
{ok, Socket} ->
|
||||
Socket;
|
||||
{error, _} ->
|
||||
error
|
||||
end.
|
||||
|
||||
setopts(ssl, Socket, Options) ->
|
||||
ssl:setopts(Socket, Options);
|
||||
setopts(_, Socket, Options) ->
|
||||
inet:setopts(Socket, Options).
|
||||
|
||||
port(ssl, Socket) ->
|
||||
{ok, {_, Port}} = ssl:sockname(Socket),
|
||||
Port;
|
||||
port(_, Socket) ->
|
||||
{ok, Port} = inet:port(Socket),
|
||||
Port.
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
-module(webserver_utils).
|
||||
|
||||
-compile(export_all).
|
||||
|
||||
-define(DEFAULT_STRING, "Great success!").
|
||||
|
||||
default_string() ->
|
||||
?DEFAULT_STRING.
|
||||
|
||||
empty_body(Module, Socket, _, _, _) ->
|
||||
Module:send(
|
||||
Socket,
|
||||
"HTTP/1.1 200 OK\r\n"
|
||||
"Content-type: text/plain\r\nContent-length: 0\r\n\r\n"
|
||||
).
|
||||
|
||||
copy_body_100_continue(Module, Socket, _, _, Body) ->
|
||||
Module:send(
|
||||
Socket,
|
||||
[
|
||||
"HTTP/1.1 100 Continue\r\n\r\n"
|
||||
"HTTP/1.1 200 OK\r\n"
|
||||
"Content-type: text/plain\r\nContent-length: "
|
||||
++ integer_to_list(size(Body)) ++ "\r\n\r\n",
|
||||
Body
|
||||
]
|
||||
).
|
||||
|
||||
pre_1_1_server(Module, Socket, _, _, Body) ->
|
||||
Pid = list_to_pid(binary_to_list(Body)),
|
||||
Module:send(
|
||||
Socket,
|
||||
"HTTP/1.0 200 OK\r\n"
|
||||
"Content-type: text/plain\r\nContent-length: 14\r\n\r\n"
|
||||
?DEFAULT_STRING
|
||||
),
|
||||
% We didn't signal a connection close, but we want the client to do that
|
||||
% any way since we're 1.0 now
|
||||
{error, closed} = Module:recv(Socket, 0),
|
||||
Pid ! closed,
|
||||
Module:close(Socket).
|
||||
|
||||
pre_1_1_server_keep_alive(Module, Socket, _, _, _) ->
|
||||
Module:send(
|
||||
Socket,
|
||||
"HTTP/1.0 200 OK\r\n"
|
||||
"Content-type: text/plain\r\n"
|
||||
"Connection: Keep-Alive\r\n"
|
||||
"Content-length: 14\r\n\r\n"
|
||||
?DEFAULT_STRING
|
||||
).
|
||||
|
||||
very_slow_response(Module, Socket, _, _, _) ->
|
||||
timer:sleep(1000),
|
||||
Module:send(
|
||||
Socket,
|
||||
"HTTP/1.1 200 OK\r\n"
|
||||
"Content-type: text/plain\r\nContent-length: 14\r\n\r\n"
|
||||
?DEFAULT_STRING
|
||||
).
|
||||
|
||||
no_content_length(Module, Socket, _, _, _) ->
|
||||
Module:send(
|
||||
Socket,
|
||||
"HTTP/1.1 200 OK\r\n"
|
||||
"Content-type: text/plain\r\nConnection: close\r\n\r\n"
|
||||
?DEFAULT_STRING
|
||||
).
|
||||
|
||||
no_content_length_1_0(Module, Socket, _, _, _) ->
|
||||
Module:send(
|
||||
Socket,
|
||||
"HTTP/1.0 200 OK\r\n"
|
||||
"Content-type: text/plain\r\n\r\n"
|
||||
?DEFAULT_STRING
|
||||
).
|
||||
|
||||
trailing_space_header(Module, Socket, _, _, _) ->
|
||||
Module:send(
|
||||
Socket,
|
||||
"HTTP/1.1 200 OK\r\n"
|
||||
"Content-type: text/plain\r\n"
|
||||
"Content-Length: 14 \r\n\r\n"
|
||||
?DEFAULT_STRING
|
||||
).
|
||||
|
||||
no_response(_, _, _, _, _) ->
|
||||
ok.
|
||||
Loading…
Reference in New Issue