New features and bug fixes

include/lhttpc.hrl

@@ -0,0 +1,34 @@
+%%% ----------------------------------------------------------------------------
+%%% 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(lhttpc_url, {
+    host :: string(),
+    port :: integer(),
+    path :: string(),
+    is_ssl:: boolean(),
+    user = "" :: string(),
+    password = "" :: string()
+}).

rebar.config

@@ -2,3 +2,4 @@
 {erl_opts, [debug_info]}.
 {cover_enabled, true}.
 {dialyzer_opts, [{warnings, [unmatched_returns]}]}.
+{eunit_opts, [verbose]}.

src/lhttpc.app.src

@@ -34,6 +34,6 @@
         {registered, [lhttpc_manager]},
         {applications, [kernel, stdlib, ssl, crypto]},
   {mod, {lhttpc, nil}},
-  {env, [{connection_timeout, 300000}]}
+  {env, [{connection_timeout, 300000}, {pool_size, 50}]}
  ]}.
 

src/lhttpc.erl

@@ -44,6 +44,7 @@
         ]).
 
 -include("lhttpc_types.hrl").
+-include("lhttpc.hrl").
 
 -type result() :: {ok, {{pos_integer(), string()}, headers(), binary()}} |
     {error, atom()}.
@@ -155,13 +156,19 @@ request(URL, Method, Hdrs, Body, Timeout) ->
 %%            {connect_options, [ConnectOptions]} |
 %%            {send_retry, integer()} |
 %%            {partial_upload, WindowSize} |
-%%            {partial_download, PartialDownloadOptions}
+%%            {partial_download, PartialDownloadOptions} |
+%%            {proxy, ProxyUrl} |
+%%            {proxy_ssl_options, SslOptions} |
+%%            {pool, LhttcPool}
 %%   Milliseconds = integer()
 %%   ConnectOptions = term()
 %%   WindowSize = integer() | infinity
 %%   PartialDownloadOptions = [PartialDownloadOption]
 %%   PartialDowloadOption = {window_size, WindowSize} |
 %%                          {part_size, PartSize}
+%%   ProxyUrl = string()
+%%   SslOptions = [any()]
+%%   LhttcPool = pid() | atom()
 %%   PartSize = integer() | infinity
 %%   Result = {ok, {{StatusCode, ReasonPhrase}, Hdrs, ResponseBody}} |
 %%            {ok, UploadState} | {error, Reason}
@@ -171,7 +178,7 @@ request(URL, Method, Hdrs, Body, Timeout) ->
 %%   Reason = connection_closed | connect_timeout | timeout
 %% @doc Sends a request with a body.
 %% Would be the same as calling <pre>
-%% {Host, Port, Path, Ssl} = lhttpc_lib:parse_url(URL),
+%% #lhttpc_url{host = Host, port = Port, path = Path, is_ssl = Ssl} = lhttpc_lib:parse_url(URL),
 %% request(Host, Port, Path, Ssl, Method, Hdrs, Body, Timeout, Options).
 %% </pre>
 %%
@@ -182,8 +189,22 @@ request(URL, Method, Hdrs, Body, Timeout) ->
 -spec request(string(), string() | atom(), headers(), iolist(),
         pos_integer() | infinity, [option()]) -> result().
 request(URL, Method, Hdrs, Body, Timeout, Options) ->
-    {Host, Port, Path, Ssl} = lhttpc_lib:parse_url(URL),
-    request(Host, Port, Ssl, Path, Method, Hdrs, Body, Timeout, Options).
+    #lhttpc_url{
+         host = Host,
+         port = Port,
+         path = Path,
+         is_ssl = Ssl,
+         user = User,
+         password = Passwd
+        } = lhttpc_lib:parse_url(URL),
+    Headers = case User of
+        "" ->
+            Hdrs;
+        _ ->
+            Auth = "Basic " ++ binary_to_list(base64:encode(User ++ ":" ++ Passwd)),
+            lists:keystore("Authorization", 1, Hdrs, {"Authorization", Auth})
+    end,
+    request(Host, Port, Ssl, Path, Method, Headers, Body, Timeout, Options).
 
 %% @spec (Host, Port, Ssl, Path, Method, Hdrs, RequestBody, Timeout, Options) ->
 %%                                                                        Result
@@ -202,12 +223,18 @@ request(URL, Method, Hdrs, Body, Timeout, Options) ->
 %%            {connect_options, [ConnectOptions]} |
 %%            {send_retry, integer()} |
 %%            {partial_upload, WindowSize} |
-%%            {partial_download, PartialDownloadOptions}
+%%            {partial_download, PartialDownloadOptions} |
+%%            {proxy, ProxyUrl} |
+%%            {proxy_ssl_options, SslOptions} |
+%%            {pool, LhttcPool}
 %%   Milliseconds = integer()
 %%   WindowSize = integer()
 %%   PartialDownloadOptions = [PartialDownloadOption]
 %%   PartialDowloadOption = {window_size, WindowSize} |
 %%                          {part_size, PartSize}
+%%   ProxyUrl = string()
+%%   SslOptions = [any()]
+%%   LhttcPool = pid() | atom()
 %%   PartSize = integer() | infinity
 %%   Result = {ok, {{StatusCode, ReasonPhrase}, Hdrs, ResponseBody}}
 %%          | {error, Reason}
@@ -314,6 +341,15 @@ request(URL, Method, Hdrs, Body, Timeout, Options) ->
 %% `undefined'. The functions {@link get_body_part/1} and
 %% {@link get_body_part/2} can be used to read body parts in the calling
 %% process.
+%%
+%% `{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(string(), 1..65535, true | false, string(), atom() | string(),
     headers(), iolist(), pos_integer(), [option()]) -> result().
@@ -553,6 +589,15 @@ verify_options([{partial_download, DownloadOptions} | Options], Errors)
 verify_options([{connect_options, List} | Options], Errors)
         when is_list(List) ->
     verify_options(Options, Errors);
+verify_options([{proxy, List} | Options], Errors)
+        when is_list(List) ->
+    verify_options(Options, Errors);
+verify_options([{proxy_ssl_options, List} | Options], Errors)
+        when is_list(List) ->
+    verify_options(Options, Errors);
+verify_options([{pool, PidOrName} | Options], Errors)
+        when is_pid(PidOrName); is_atom(PidOrName) ->
+    verify_options(Options, Errors);
 verify_options([Option | Options], Errors) ->
     verify_options(Options, [Option | Errors]);
 verify_options([], []) ->

src/lhttpc_client.erl

@@ -34,6 +34,7 @@
 -export([request/9]).
 
 -include("lhttpc_types.hrl").
+-include("lhttpc.hrl").
 
 -record(client_state, {
         host :: string(),
@@ -52,9 +53,12 @@
         upload_window :: non_neg_integer() | infinity,
         partial_download = false :: true | false,
         download_window = infinity :: timeout(),
-        part_size :: non_neg_integer() | infinity
+        part_size :: non_neg_integer() | infinity,
         %% in case of infinity we read whatever data we can get from
         %% the wire at that point or in case of chunked one chunk
+        proxy :: undefined | #lhttpc_url{},
+        proxy_ssl_options = [] :: [any()],
+        proxy_setup = false :: true | false
     }).
 
 -define(CONNECTION_HDR(HDRS, DEFAULT),
@@ -100,10 +104,21 @@ execute(From, Host, Port, Ssl, Path, Method, Hdrs, Body, Options) ->
     PartialDownload = proplists:is_defined(partial_download, Options),
     PartialDownloadOptions = proplists:get_value(partial_download, Options, []),
     NormalizedMethod = lhttpc_lib:normalize_method(Method),
+    Proxy = case proplists:get_value(proxy, Options) of
+        undefined ->
+            undefined;
+        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);
+        ProxyUrl when is_list(ProxyUrl) ->
+            lhttpc_lib:parse_url(ProxyUrl)
+    end,
     {ChunkedUpload, Request} = lhttpc_lib:format_request(Path, NormalizedMethod,
         Hdrs, Host, Port, Body, PartialUpload),
     SocketRequest = {socket, self(), Host, Port, Ssl},
-    Socket = case gen_server:call(lhttpc_manager, SocketRequest, infinity) of
+    Pool = proplists:get_value(pool, Options, whereis(lhttpc_manager)),
+    Socket = case gen_server:call(Pool, SocketRequest, infinity) of
         {ok, S}   -> S; % Re-using HTTP/1.1 connections
         no_socket -> undefined % Opening a new HTTP/1.1 connection
     end,
@@ -127,7 +142,10 @@ execute(From, Host, Port, Ssl, Path, Method, Hdrs, Body, Options) ->
         download_window = proplists:get_value(window_size,
             PartialDownloadOptions, infinity),
         part_size = proplists:get_value(part_size,
-            PartialDownloadOptions, infinity)
+            PartialDownloadOptions, infinity),
+        proxy = Proxy,
+        proxy_setup = (Socket =/= undefined),
+        proxy_ssl_options = proplists:get_value(proxy_ssl_options, Options, [])
     },
     Response = case send_request(State) of
         {R, undefined} ->
@@ -141,11 +159,10 @@ execute(From, Host, Port, Ssl, Path, Method, Hdrs, Body, Options) ->
             % * The socket was closed remotely already
             % * Due to an error in this module (returning dead sockets for
             %   instance)
-            ManagerPid = whereis(lhttpc_manager),
-            case lhttpc_sock:controlling_process(NewSocket, ManagerPid, Ssl) of
+            case lhttpc_sock:controlling_process(NewSocket, Pool, Ssl) of
                 ok ->
-                    gen_server:cast(lhttpc_manager,
-                        {done, Host, Port, Ssl, NewSocket});
+                    DoneMsg = {done, Host, Port, Ssl, NewSocket},
+                    ok = gen_server:call(Pool, DoneMsg, infinity);
                 _ ->
                     ok
             end,
@@ -157,11 +174,17 @@ send_request(#client_state{attempts = 0}) ->
     % Don't try again if the number of allowed attempts is 0.
     throw(connection_closed);
 send_request(#client_state{socket = undefined} = State) ->
-    Host = State#client_state.host,
-    Port = State#client_state.port,
-    Ssl = State#client_state.ssl,
+    {Host, Port, Ssl} = request_first_destination(State),
     Timeout = State#client_state.connect_timeout,
-    ConnectOptions = State#client_state.connect_options,
+    ConnectOptions0 = State#client_state.connect_options,
+    ConnectOptions = case (not lists:member(inet, ConnectOptions0)) andalso
+                         (not lists:member(inet6, ConnectOptions0)) andalso
+                         is_ipv6_host(Host) of
+        true ->
+            [inet6 | ConnectOptions0];
+        false ->
+            ConnectOptions0
+    end,
     SocketOptions = [binary, {packet, http}, {active, false} | ConnectOptions],
     case lhttpc_sock:connect(Host, Port, SocketOptions, Timeout, Ssl) of
         {ok, Socket} ->
@@ -174,6 +197,46 @@ send_request(#client_state{socket = undefined} = State) ->
         {error, Reason} ->
             erlang:error(Reason)
     end;
+send_request(#client_state{proxy = #lhttpc_url{}, proxy_setup = false} = State) ->
+    #lhttpc_url{
+        user = User,
+        password = Passwd,
+        is_ssl = Ssl
+    } = State#client_state.proxy,
+    #client_state{
+        host = DestHost,
+        port = Port,
+        socket = Socket
+    } = State,
+    Host = case inet_parse:address(DestHost) of
+        {ok, {_, _, _, _, _, _, _, _}} ->
+            % IPv6 address literals are enclosed by square brackets (RFC2732)
+            [$[, DestHost, $], $:, integer_to_list(Port)];
+        _ ->
+            [DestHost, $:, integer_to_list(Port)]
+    end,
+    ConnectRequest = [
+        "CONNECT ", Host, " HTTP/1.1\r\n",
+        "Host: ", Host, "\r\n",
+        case User of
+            "" ->
+                "";
+            _ ->
+                ["Proxy-Authorization: Basic ",
+                    base64:encode(User ++ ":" ++ Passwd), "\r\n"]
+        end,
+        "\r\n"
+    ],
+    case lhttpc_sock:send(Socket, ConnectRequest, Ssl) of
+        ok ->
+            read_proxy_connect_response(State, nil, nil);
+        {error, closed} ->
+            lhttpc_sock:close(Socket, Ssl),
+            throw(proxy_connection_closed);
+        {error, Reason} ->
+            lhttpc_sock:close(Socket, Ssl),
+            erlang:error(Reason)
+    end;
 send_request(State) ->
     Socket = State#client_state.socket,
     Ssl = State#client_state.ssl,
@@ -196,6 +259,49 @@ send_request(State) ->
             erlang:error(Reason)
     end.
 
+request_first_destination(#client_state{proxy = #lhttpc_url{} = Proxy}) ->
+    {Proxy#lhttpc_url.host, Proxy#lhttpc_url.port, Proxy#lhttpc_url.is_ssl};
+request_first_destination(#client_state{host = Host, port = Port, ssl = Ssl}) ->
+    {Host, Port, Ssl}.
+
+read_proxy_connect_response(State, StatusCode, StatusText) ->
+    Socket = State#client_state.socket,
+    ProxyIsSsl = (State#client_state.proxy)#lhttpc_url.is_ssl,
+    case lhttpc_sock:recv(Socket, ProxyIsSsl) of
+        {ok, {http_response, _Vsn, Code, Reason}} ->
+            read_proxy_connect_response(State, Code, Reason);
+        {ok, {http_header, _, _Name, _, _Value}} ->
+            read_proxy_connect_response(State, StatusCode, StatusText);
+        {ok, http_eoh} when StatusCode >= 100, StatusCode =< 199 ->
+            % 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, nil, nil);
+        {ok, http_eoh} when StatusCode >= 200, StatusCode < 300 ->
+            % 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,
+            State2 = case ssl:connect(Socket, SslOptions ++ ConnectOptions, Timeout) of
+                {ok, SslSocket} ->
+                    State#client_state{socket = SslSocket, proxy_setup = true};
+                {error, Reason} ->
+                    lhttpc_sock:close(Socket, ProxyIsSsl),
+                    erlang:error({proxy_connection_failed, Reason})
+            end,
+            send_request(State2);
+        {ok, http_eoh} ->
+            throw({proxy_connection_refused, StatusCode, StatusText});
+        {error, closed} ->
+            lhttpc_sock:close(Socket, ProxyIsSsl),
+            throw(proxy_connection_closed);
+        {error, Reason} ->
+            erlang:error({proxy_connection_failed, Reason})
+    end.
+
 partial_upload(State) ->
     Response = {ok, {self(), State#client_state.upload_window}},
     State#client_state.requester ! {response, self(), Response},
@@ -664,3 +770,24 @@ maybe_close_socket(Socket, Ssl, _, ReqHdrs, RespHdrs) ->
         ClientConnection =/= "close", ServerConnection =:= "keep-alive" ->
             Socket
     end.
+
+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.