You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@couchdb.apache.org by cm...@apache.org on 2008/03/29 00:32:30 UTC
svn commit: r642432 [5/16] - in /incubator/couchdb/trunk: ./ bin/
build-contrib/ etc/ etc/conf/ etc/default/ etc/init/ etc/launchd/
etc/logrotate.d/ share/ share/server/ share/www/ share/www/browse/
share/www/image/ share/www/script/ share/www/style/ s...
Added: incubator/couchdb/trunk/src/couch_inets/http.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/http.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/http.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/http.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,396 @@
+% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+%% This module is very loosely based on code initially developed by
+%% Johan Blom at Mobile Arts AB
+%% Description:
+%%% This version of the HTTP/1.1 client supports:
+%%% - RFC 2616 HTTP 1.1 client part
+%%% - RFC 2818 HTTP Over TLS
+
+-module(http).
+
+%% API
+-export([request/1, request/4, cancel_request/1, set_options/1,
+ verify_cookies/2, cookie_header/1]).
+
+-include("http_internal.hrl").
+-include("httpc_internal.hrl").
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+%%--------------------------------------------------------------------------
+%% request(Method, Request, HTTPOptions, Options) ->
+%% {ok, {StatusLine, Headers, Body}} | {ok, {Status, Body}} |
+%% {ok, RequestId} | {error,Reason} | {ok, {saved_as, FilePath}
+%%
+%% Method - atom() = head | get | put | post | trace | options| delete
+%% Request - {Url, Headers} | {Url, Headers, ContentType, Body}
+%% Url - string()
+%% HTTPOptions - [HttpOption]
+%% HTTPOption - {timeout, Time} | {ssl, SSLOptions} |
+%% {proxy_auth, {User, Password}}
+%% Ssloptions = [SSLOption]
+%% SSLOption = {verify, code()} | {depth, depth()} | {certfile, path()} |
+%% {keyfile, path()} | {password, string()} | {cacertfile, path()} |
+%% {ciphers, string()}
+%% Options - [Option]
+%% Option - {sync, Boolean} | {body_format, BodyFormat} |
+%% {full_result, Boolean} | {stream, To} |
+%% {headers_as_is, Boolean}
+%% StatusLine = {HTTPVersion, StatusCode, ReasonPhrase}</v>
+%% HTTPVersion = string()
+%% StatusCode = integer()
+%% ReasonPhrase = string()
+%% Headers = [Header]
+%% Header = {Field, Value}
+%% Field = string()
+%% Value = string()
+%% Body = string() | binary() - HTLM-code
+%%
+%% Description: Sends a HTTP-request. The function can be both
+%% syncronus and asynchronous in the later case the function will
+%% return {ok, RequestId} and later on a message will be sent to the
+%% calling process on the format {http, {RequestId, {StatusLine,
+%% Headers, Body}}} or {http, {RequestId, {error, Reason}}}
+%% %%--------------------------------------------------------------------------
+request(Url) ->
+ request(get, {Url, []}, [], []).
+
+request(Method, {Url, Headers}, HTTPOptions, Options)
+ when Method==options;Method==get;Method==head;Method==delete;Method==trace ->
+ case http_uri:parse(Url) of
+ {error,Reason} ->
+ {error,Reason};
+ ParsedUrl ->
+ handle_request(Method, Url, {ParsedUrl, Headers, [], []},
+ HTTPOptions, Options)
+ end;
+
+request(Method, {Url,Headers,ContentType,Body}, HTTPOptions, Options)
+ when Method==post;Method==put ->
+ case http_uri:parse(Url) of
+ {error,Reason} ->
+ {error,Reason};
+ ParsedUrl ->
+ handle_request(Method, Url,
+ {ParsedUrl, Headers, ContentType, Body},
+ HTTPOptions, Options)
+ end.
+
+%%--------------------------------------------------------------------------
+%% request(RequestId) -> ok
+%% RequestId - As returned by request/4
+%%
+%% Description: Cancels a HTTP-request.
+%%-------------------------------------------------------------------------
+cancel_request(RequestId) ->
+ ok = httpc_manager:cancel_request(RequestId),
+ receive
+ %% If the request was allready fullfilled throw away the
+ %% answer as the request has been canceled.
+ {http, {RequestId, _}} ->
+ ok
+ after 0 ->
+ ok
+ end.
+
+%%--------------------------------------------------------------------------
+%% set_options(Options) ->
+%% Options - [Option]
+%% Option - {proxy, {Proxy, NoProxy}} | {max_sessions, MaxSessions} |
+%% {max_pipeline_length, MaxPipeline} |
+%% {pipeline_timeout, PipelineTimeout} | {cookies, CookieMode}
+%% | {ipv6, Ipv6Mode}
+%% Proxy - {Host, Port}
+%% NoProxy - [Domain | HostName | IPAddress]
+%% MaxSessions, MaxPipeline, PipelineTimeout = integer()
+%% CookieMode - enabled | disabled | verify
+%% Ipv6Mode - enabled | disabled
+%% Description: Informs the httpc_manager of the new settings.
+%%-------------------------------------------------------------------------
+set_options(Options) ->
+ ensure_started(no_scheme),
+ httpc_manager:set_options(Options).
+
+verify_cookies(SetCookieHeaders, Url) ->
+ {_, _, Host, Port, Path, _} = http_uri:parse(Url),
+ Cookies = http_cookie:cookies(SetCookieHeaders, Path, Host),
+ httpc_manager:store_cookies(Cookies, {Host, Port}),
+ ok.
+
+cookie_header(Url) ->
+ httpc_manager:cookies(Url).
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+handle_request(Method, Url, {{Scheme, UserInfo, Host, Port, Path, Query},
+ Headers, ContentType, Body}, HTTPOptions, Options) ->
+ HTTPRecordOptions = http_options(HTTPOptions, #http_options{}),
+
+ Sync = http_util:key1search(Options, sync, true),
+ NewHeaders = lists:map(fun({Key, Val}) ->
+ {http_util:to_lower(Key), Val} end,
+ Headers),
+ Stream = http_util:key1search(Options, stream, none),
+
+ case {Sync, Stream} of
+ {true, self} ->
+ {error, streaming_error};
+ _ ->
+ RecordHeaders = header_record(NewHeaders, #http_request_h{}, Host),
+ Request = #request{from = self(),
+ scheme = Scheme, address = {Host,Port},
+ path = Path, pquery = Query, method = Method,
+ headers = RecordHeaders,
+ content = {ContentType,Body},
+ settings = HTTPRecordOptions,
+ abs_uri = Url, userinfo = UserInfo,
+ stream = Stream,
+ headers_as_is =
+ headers_as_is(Headers, Options)},
+
+ ensure_started(Scheme),
+
+ case httpc_manager:request(Request) of
+ {ok, RequestId} ->
+ handle_answer(RequestId, Sync, Options);
+ {error, Reason} ->
+ {error, Reason}
+ end
+ end.
+
+handle_answer(RequestId, false, _) ->
+ {ok, RequestId};
+handle_answer(RequestId, true, Options) ->
+ receive
+ {http, {RequestId, saved_to_file}} ->
+ {ok, saved_to_file};
+ {http, {RequestId, Result = {_,_,_}}} ->
+ return_answer(Options, Result);
+ {http, {RequestId, {error, Reason}}} ->
+ {error, Reason}
+ end.
+
+return_answer(Options, {StatusLine, Headers, BinBody}) ->
+ Body =
+ case http_util:key1search(Options, body_format, string) of
+ string ->
+ binary_to_list(BinBody);
+ _ ->
+ BinBody
+ end,
+ case http_util:key1search(Options, full_result, true) of
+ true ->
+ {ok, {StatusLine, Headers, Body}};
+ false ->
+ {_, Status, _} = StatusLine,
+ {ok, {Status, Body}}
+ end.
+
+
+%% This options is a workaround for http servers that do not follow the
+%% http standard and have case sensative header parsing. Should only be
+%% used if there is no other way to communicate with the server or for
+%% testing purpose.
+headers_as_is(Headers, Options) ->
+ case http_util:key1search(Options, headers_as_is, false) of
+ false ->
+ [];
+ true ->
+ Headers
+ end.
+
+http_options([], Acc) ->
+ Acc;
+http_options([{timeout, Val} | Settings], Acc)
+ when is_integer(Val), Val >= 0->
+ http_options(Settings, Acc#http_options{timeout = Val});
+http_options([{timeout, infinity} | Settings], Acc) ->
+ http_options(Settings, Acc#http_options{timeout = infinity});
+http_options([{autoredirect, Val} | Settings], Acc)
+ when Val == true; Val == false ->
+ http_options(Settings, Acc#http_options{autoredirect = Val});
+http_options([{ssl, Val} | Settings], Acc) ->
+ http_options(Settings, Acc#http_options{ssl = Val});
+http_options([{relaxed, Val} | Settings], Acc)
+ when Val == true; Val == false ->
+ http_options(Settings, Acc#http_options{relaxed = Val});
+http_options([{proxy_auth, Val = {User, Passwd}} | Settings], Acc)
+ when is_list(User),
+ is_list(Passwd) ->
+ http_options(Settings, Acc#http_options{proxy_auth = Val});
+http_options([Option | Settings], Acc) ->
+ error_logger:info_report("Invalid option ignored ~p~n", [Option]),
+ http_options(Settings, Acc).
+
+header_record([], RequestHeaders, Host) ->
+ validate_headers(RequestHeaders, Host);
+header_record([{"cache-control", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'cache-control' = Val},
+ Host);
+header_record([{"connection", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{connection = Val}, Host);
+header_record([{"date", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{date = Val}, Host);
+header_record([{"pragma", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{pragma = Val}, Host);
+header_record([{"trailer", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{trailer = Val}, Host);
+header_record([{"transfer-encoding", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest,
+ RequestHeaders#http_request_h{'transfer-encoding' = Val},
+ Host);
+header_record([{"upgrade", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{upgrade = Val}, Host);
+header_record([{"via", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{via = Val}, Host);
+header_record([{"warning", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{warning = Val}, Host);
+header_record([{"accept", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{accept = Val}, Host);
+header_record([{"accept-charset", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'accept-charset' = Val},
+ Host);
+header_record([{"accept-encoding", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'accept-encoding' = Val},
+ Host);
+header_record([{"accept-language", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'accept-language' = Val},
+ Host);
+header_record([{"authorization", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{authorization = Val},
+ Host);
+header_record([{"expect", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{expect = Val}, Host);
+header_record([{"from", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{from = Val}, Host);
+header_record([{"host", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{host = Val}, Host);
+header_record([{"if-match", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'if-match' = Val},
+ Host);
+header_record([{"if-modified-since", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest,
+ RequestHeaders#http_request_h{'if-modified-since' = Val},
+ Host);
+header_record([{"if-none-match", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'if-none-match' = Val},
+ Host);
+header_record([{"if-range", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'if-range' = Val},
+ Host);
+
+header_record([{"if-unmodified-since", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'if-unmodified-since'
+ = Val}, Host);
+header_record([{"max-forwards", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'max-forwards' = Val},
+ Host);
+header_record([{"proxy-authorization", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'proxy-authorization'
+ = Val}, Host);
+header_record([{"range", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{range = Val}, Host);
+header_record([{"referer", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{referer = Val}, Host);
+header_record([{"te", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{te = Val}, Host);
+header_record([{"user-agent", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'user-agent' = Val},
+ Host);
+header_record([{"allow", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{allow = Val}, Host);
+header_record([{"content-encoding", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest,
+ RequestHeaders#http_request_h{'content-encoding' = Val},
+ Host);
+header_record([{"content-language", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest,
+ RequestHeaders#http_request_h{'content-language' = Val},
+ Host);
+header_record([{"content-length", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'content-length' = Val},
+ Host);
+header_record([{"content-location", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest,
+ RequestHeaders#http_request_h{'content-location' = Val},
+ Host);
+header_record([{"content-md5", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'content-md5' = Val},
+ Host);
+header_record([{"content-range", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'content-range' = Val},
+ Host);
+header_record([{"content-type", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'content-type' = Val},
+ Host);
+header_record([{"expires", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{expires = Val}, Host);
+header_record([{"last-modified", Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{'last-modified' = Val},
+ Host);
+header_record([{Key, Val} | Rest], RequestHeaders, Host) ->
+ header_record(Rest, RequestHeaders#http_request_h{
+ other = [{Key, Val} |
+ RequestHeaders#http_request_h.other]},
+ Host).
+
+validate_headers(RequestHeaders = #http_request_h{te = undefined}, Host) ->
+ validate_headers(RequestHeaders#http_request_h{te = ""}, Host);
+validate_headers(RequestHeaders = #http_request_h{host = undefined}, Host) ->
+ validate_headers(RequestHeaders#http_request_h{host = Host}, Host);
+validate_headers(RequestHeaders, _) ->
+ RequestHeaders.
+
+ensure_started(Scheme) ->
+ %% Start of the inets application should really be handled by the
+ %% application using inets.
+ case application:start(couch_inets) of
+ {error,{already_started,couch_inets}} ->
+ ok;
+ {error, {{already_started,_}, % Started as an included application
+ {inets_app, start, _}}} ->
+ ok;
+ ok ->
+ error_logger:info_report("The inets application was not started."
+ " Has now been started as a temporary"
+ " application.")
+ end,
+
+ case Scheme of
+ https ->
+ %% Start of the ssl application should really be handled by the
+ %% application using inets.
+ case application:start(ssl) of
+ {error,{already_started,ssl}} ->
+ ok;
+ %% Started as an included application
+ {error, {{already_started,_},
+ {ssl_app, start, _}}} ->
+ ok;
+ ok ->
+ error_logger:info_report("The ssl application was not "
+ "started. Has now been started "
+ "as a temporary application.")
+ end;
+ _ ->
+ ok
+ end.
Added: incubator/couchdb/trunk/src/couch_inets/http_base_64.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/http_base_64.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/http_base_64.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/http_base_64.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,126 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+%% Description: Implements base 64 encode and decode, see RFC2045.
+-module(http_base_64).
+
+-export([encode/1, decode/1]).
+
+-deprecated({'_', '_', next_major_release}).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+%%-------------------------------------------------------------------------
+%% encode(ASCII) -> Base64
+%% ASCII - string()
+%% Base64 - string()
+%%
+%% Description: Encodes a plain ASCII string into base64.
+%%-------------------------------------------------------------------------
+encode(ASCII) when is_list(ASCII) ->
+ encode_base64_list(ASCII).
+
+
+%%-------------------------------------------------------------------------
+%% decode(Base64) -> ASCII
+%% Base64 - string()
+%% ASCII - string()
+%%
+%% Description: Decodes an base64 encoded string to plain ASCII.
+%%-------------------------------------------------------------------------
+decode(Base64) when is_list(Base64) ->
+ decode_base64_list(sixtets(Base64), []).
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
+%% Base-64 encoding: take 6 bits at a time from the head of the binary
+%% and emit it as 8 bit characters.
+encode_base64_list([]) ->
+ [];
+encode_base64_list([A]) ->
+ [int_to_b64(A bsr 2), int_to_b64((A band 3) bsl 4), $=, $=];
+encode_base64_list([A,B]) ->
+ [int_to_b64(A bsr 2), int_to_b64(((A band 3) bsl 4) bor (B bsr 4)),
+ int_to_b64((B band 15) bsl 2), $=];
+encode_base64_list([A,B,C|Ls]) ->
+ encode_base64_list_do(A,B,C, Ls).
+
+encode_base64_list_do(A,B,C, Rest) ->
+ BB = (A bsl 16) bor (B bsl 8) bor C,
+ [int_to_b64(BB bsr 18), int_to_b64((BB bsr 12) band 63),
+ int_to_b64((BB bsr 6) band 63), int_to_b64(BB band 63) |
+ encode_base64_list(Rest)].
+
+int_to_b64(X) when X >= 0, X =< 25 -> X + $A;
+int_to_b64(X) when X >= 26, X =< 51 -> X - 26 + $a;
+int_to_b64(X) when X >= 52, X =< 61 -> X - 52 + $0;
+int_to_b64(62) -> $+;
+int_to_b64(63) -> $/.
+
+%% This version works by consuming groups of 4 input characters to create
+%% a group of 3 output characters, with the three special-cases for
+%% end-of-input first:
+
+decode_base64_list({[],[]}, Acc) ->
+ lists:reverse(Acc);
+decode_base64_list({[Sixtet1,Sixtet2,pad,pad], []}, Acc) ->
+ Bits2x6 = (Sixtet1 bsl 18) bor (Sixtet2 bsl 12),
+ Octet1 = Bits2x6 bsr 16,
+ lists:reverse([Octet1 | Acc]);
+decode_base64_list({[Sixtet1,Sixtet2,Sixtet3,pad], []}, Acc) ->
+ Bits3x6 = (Sixtet1 bsl 18) bor (Sixtet2 bsl 12) bor (Sixtet3 bsl 6),
+ Octet1 = Bits3x6 bsr 16,
+ Octet2 = (Bits3x6 bsr 8) band 16#ff,
+ lists:reverse([Octet2, Octet1 | Acc]);
+decode_base64_list({[Sixtet1,Sixtet2,Sixtet3,Sixtet4],Rest}, Acc) when
+ Sixtet1 =/= pad,
+ Sixtet2 =/= pad,
+ Sixtet3 =/= pad,
+ Sixtet4 =/= pad ->
+ Bits4x6 =
+ (Sixtet1 bsl 18) bor (Sixtet2 bsl 12) bor (Sixtet3 bsl 6) bor Sixtet4,
+ Octet1 = Bits4x6 bsr 16,
+ Octet2 = (Bits4x6 bsr 8) band 16#ff,
+ Octet3 = Bits4x6 band 16#ff,
+ decode_base64_list(sixtets(Rest), [Octet3, Octet2, Octet1 | Acc]).
+
+b64_to_int(X) when X >= $A, X =< $Z -> X - $A;
+b64_to_int(X) when X >= $a, X =< $z -> X - $a + 26;
+b64_to_int(X) when X >= $0, X =< $9 -> X - $0 + 52;
+b64_to_int($+) -> 62;
+b64_to_int($/) -> 63;
+b64_to_int($=) -> pad; % Padding will be removed by decode_base64_list/2
+b64_to_int(_) -> ignore. % Not in base 64 should be ignored
+
+sixtets(Str) ->
+ sixtets(Str, []).
+
+sixtets([], Sixtets) ->
+ {lists:reverse(Sixtets), []};
+sixtets(Rest, Sixtets) when length(Sixtets) == 4 ->
+ {lists:reverse(Sixtets), Rest};
+sixtets([Base64 | Tail], Sixtets) when length(Sixtets) < 4 ->
+ case b64_to_int(Base64) of
+ ignore ->
+ sixtets(Tail, Sixtets);
+ Int ->
+ sixtets(Tail, [Int | Sixtets])
+ end.
Added: incubator/couchdb/trunk/src/couch_inets/http_chunk.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/http_chunk.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/http_chunk.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/http_chunk.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,289 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%% Description: Implements chunked transfer encoding see RFC2616 section
+%% 3.6.1
+-module(http_chunk).
+
+-include("http_internal.hrl").
+
+%% API
+-export([decode/3, decode/4, encode/1, encode_last/0, handle_headers/2]).
+%% Callback API - used for example if the chunkedbody is received a
+%% little at a time on a socket.
+-export([decode_size/1, ignore_extensions/1, decode_data/1, decode_trailer/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+%%-------------------------------------------------------------------------
+%% decode(ChunkedBody, MaxBodySize, MaxHeaderSize, <Stream>) ->
+%% {ok, {Headers, Body}} | {Module, Function, Args}
+%%
+%% Headers = ["Header:Value"]
+%% ChunkedBody = binary()
+%% MaxBodySize = integer()
+%% MaxHeaderSize = integer()
+%% Stream = {Code, Request} - if Request#request.stream =/= none
+%% and Code == 200 the side effect of sending each decode chunk to the
+%% client/file before the whole body is received will take place.
+%%
+%% Note: decode/4 should only be used from httpc_handler module.
+%% Otherwhise use the side effect free decode/3.
+%%
+%% Description: Decodes a body encoded by the chunked transfer
+%% encoding. If the ChunkedBody is not compleate it returns {Module,
+%% Function, Args} so that decoding can be continued when more of the
+%% data has been received by calling Module:Function([NewData | Args]).
+%%
+%% Note: In the case of pipelining a call to decode might contain data
+%% that belongs to the next request/response and will be returned as
+%% part of the body, hence functions calling http_chunk:decode must
+%% look at the returned content-length header to make sure that they
+%% split the actual body and data that possible should be passed along to
+%% the next pass in the loop.
+%%-------------------------------------------------------------------------
+decode(ChunkedBody, MaxBodySize, MaxHeaderSize) ->
+ decode(ChunkedBody, MaxBodySize, MaxHeaderSize, false).
+
+decode(ChunkedBody, MaxBodySize, MaxHeaderSize, Stream) ->
+ %% Note decode_size will call decode_data.
+ decode_size([ChunkedBody, <<>>, [],
+ {MaxBodySize, <<>>, 0, MaxHeaderSize, Stream}]).
+
+%%-------------------------------------------------------------------------
+%% encode(Chunk) -> EncodedChunk
+%%
+%% Chunked = binary()
+%% EncodedChunk = binary()
+%%
+%% Description: Encodes a body part with the chunked transfer encoding.
+%% Chunks are returned as lists or binaries depending on the
+%% input format. When sending the data on the both formats
+%% are accepted.
+%%-------------------------------------------------------------------------
+encode(Chunk) when is_binary(Chunk)->
+ HEXSize = list_to_binary(http_util:integer_to_hexlist(size(Chunk))),
+ <<HEXSize/binary, ?CR, ?LF, Chunk/binary, ?CR, ?LF>>;
+
+encode(Chunk) when is_list(Chunk)->
+ HEXSize = http_util:integer_to_hexlist(length(Chunk)),
+ [HEXSize, ?CR, ?LF, Chunk, ?CR, ?LF].
+
+encode_last() ->
+ <<$0, ?CR, ?LF, ?CR, ?LF >>.
+
+%%-------------------------------------------------------------------------
+%% handle_headers(HeaderRecord, ChunkedHeaders) -> NewHeaderRecord
+%%
+%% HeaderRecord = NewHeaderRecord = #http_request_h{} | #http_response_h{}
+%% ChunkedHeaders = ["Header:Value"] as returnde by http_chunk:decode/3
+%%
+%% Description: Removes chunked from the header as we now have decode
+%% the body and adds a content-length header and any other headers
+%% found in the chunked trail.
+%%-------------------------------------------------------------------------
+handle_headers(RequestHeaderRecord = #http_request_h{}, ChunkedHeaders) ->
+ NewHeaders = http_request:headers(ChunkedHeaders, RequestHeaderRecord),
+ TransferEncoding =
+ case NewHeaders#http_request_h.'transfer-encoding' -- "chunked" of
+ "" ->
+ undefined;
+ Other ->
+ Other
+ end,
+ NewHeaders#http_request_h{'transfer-encoding' = TransferEncoding};
+
+handle_headers(ResponseHeaderRecord = #http_response_h{}, ChunkedHeaders) ->
+ NewHeaders = http_response:headers(ChunkedHeaders, ResponseHeaderRecord),
+ TransferEncoding =
+ case NewHeaders#http_response_h.'transfer-encoding' -- "chunked" of
+ "" ->
+ undefined;
+ Other ->
+ Other
+ end,
+ NewHeaders#http_response_h{'transfer-encoding' = TransferEncoding}.
+
+%% Functions that may be returned during the decoding process
+%% if the input data is incompleate.
+decode_size([Bin, Rest, HexList, Info]) ->
+ decode_size(<<Rest/binary, Bin/binary>>, HexList, Info).
+
+ignore_extensions([Bin, Rest, NextFunction]) ->
+ ignore_extensions(<<Rest/binary, Bin/binary>>, NextFunction).
+
+decode_data([Bin, ChunkSize, TotalChunk, Info]) ->
+ decode_data(ChunkSize, <<TotalChunk/binary, Bin/binary>>, Info).
+
+decode_trailer([Bin, Rest, Header, Headers, MaxHeaderSize, Body,
+ BodyLength]) ->
+ decode_trailer(<<Rest/binary, Bin/binary>>,
+ Header, Headers, MaxHeaderSize, Body, BodyLength).
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+decode_size(<<>>, HexList, Info) ->
+ {?MODULE, decode_size, [<<>>, HexList, Info]};
+decode_size(Data = <<?CR, ?LF, ChunkRest/binary>>, HexList,
+ {MaxBodySize, Body,
+ AccLength,
+ MaxHeaderSize, Stream}) ->
+ ChunkSize = http_util:hexlist_to_integer(lists:reverse(HexList)),
+ case ChunkSize of
+ 0 -> % Last chunk, there was no data
+ ignore_extensions(Data, {?MODULE, decode_trailer,
+ [<<>>, [],[], MaxHeaderSize,
+ Body,
+ integer_to_list(AccLength)]});
+ _ ->
+ %% Note decode_data may call decode_size again if there
+ %% is more than one chunk, hence here is where the last parameter
+ %% to this function comes in.
+ decode_data(ChunkSize, ChunkRest, {MaxBodySize, Body,
+ ChunkSize + AccLength ,
+ MaxHeaderSize, Stream})
+ end;
+decode_size(<<";", Rest/binary>>, HexList, Info) ->
+ %% Note ignore_extensions will call decode_size/1 again when
+ %% it ignored all extensions.
+ ignore_extensions(Rest, {?MODULE, decode_size, [<<>>, HexList, Info]});
+decode_size(<<?CR>> = Data, HexList, Info) ->
+ {?MODULE, decode_size, [Data, HexList, Info]};
+decode_size(<<Octet, Rest/binary>>, HexList, Info) ->
+ decode_size(Rest, [Octet | HexList], Info).
+
+%% "All applications MUST ignore chunk-extension extensions they
+%% do not understand.", see RFC 2616 Section 3.6.1 We don't
+%% understand any extension...
+ignore_extensions(<<>>, NextFunction) ->
+ {?MODULE, ignore_extensions, [<<>>, NextFunction]};
+ignore_extensions(Data = <<?CR, ?LF, _ChunkRest/binary>>,
+ {Module, Function, Args}) ->
+ Module:Function([Data | Args]);
+ignore_extensions(<<?CR>> = Data, NextFunction) ->
+ {?MODULE, ignore_extensions, [Data, NextFunction]};
+ignore_extensions(<<_Octet, Rest/binary>>, NextFunction) ->
+ ignore_extensions(Rest, NextFunction).
+
+decode_data(ChunkSize, TotalChunk,
+ Info = {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize, Stream})
+ when ChunkSize =< size(TotalChunk) ->
+ case TotalChunk of
+ %% Potential last chunk
+ <<_:ChunkSize/binary, ?CR, ?LF, "0">> ->
+ {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]};
+ <<_:ChunkSize/binary, ?CR, ?LF, "0", ?CR>> ->
+ {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]};
+ <<_:ChunkSize/binary, ?CR, ?LF>> ->
+ {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]};
+ %% Last chunk
+ <<Data:ChunkSize/binary, ?CR, ?LF, "0", ";">> ->
+ %% Note ignore_extensions will call decode_trailer/1
+ %% once it ignored all extensions.
+ {NewBody, _} =
+ stream(<<BodySoFar/binary, Data/binary>>, Stream),
+ {?MODULE, ignore_extensions,
+ [<<>>,
+ {?MODULE, decode_trailer, [<<>>, [],[], MaxHeaderSize,
+ NewBody,
+ integer_to_list(AccLength)]}]};
+ <<Data:ChunkSize/binary, ?CR, ?LF, "0", ";", Rest/binary>> ->
+ %% Note ignore_extensions will call decode_trailer/1
+ %% once it ignored all extensions.
+ {NewBody, _} = stream(<<BodySoFar/binary, Data/binary>>, Stream),
+ ignore_extensions(Rest, {?MODULE, decode_trailer,
+ [<<>>, [],[], MaxHeaderSize,
+ NewBody,
+ integer_to_list(AccLength)]});
+ <<Data:ChunkSize/binary, ?CR, ?LF, "0", ?CR, ?LF>> ->
+ {NewBody, _} = stream(<<BodySoFar/binary, Data/binary>>, Stream),
+ {?MODULE, decode_trailer, [<<?CR, ?LF>>, [],[], MaxHeaderSize,
+ NewBody,
+ integer_to_list(AccLength)]};
+ <<Data:ChunkSize/binary, ?CR, ?LF, "0", ?CR, ?LF, Rest/binary>> ->
+ {NewBody,_}= stream(<<BodySoFar/binary, Data/binary>>, Stream),
+ decode_trailer(<<?CR, ?LF, Rest/binary>>, [],[], MaxHeaderSize,
+ NewBody,
+ integer_to_list(AccLength));
+ %% There are more chunks, so here we go agin...
+ <<Data:ChunkSize/binary, ?CR, ?LF, Rest/binary>>
+ when (AccLength < MaxBodySize) or (MaxBodySize == nolimit) ->
+ {NewBody, NewStream} =
+ stream(<<BodySoFar/binary, Data/binary>>, Stream),
+ decode_size(Rest, [],
+ {MaxBodySize, NewBody,
+ AccLength, MaxHeaderSize, NewStream});
+ <<_:ChunkSize/binary, ?CR, ?LF, _/binary>> ->
+ throw({error, body_too_big});
+ _ ->
+ {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]}
+ end;
+decode_data(ChunkSize, TotalChunk, Info) ->
+ {?MODULE, decode_data, [ChunkSize, TotalChunk, Info]}.
+
+decode_trailer(<<>>, Header, Headers, MaxHeaderSize, Body, BodyLength) ->
+ {?MODULE, decode_trailer, [<<>>, Header, Headers, MaxHeaderSize, Body,
+ BodyLength]};
+
+%% Note: If Bin is not empty it is part of a pipelined request/response.
+decode_trailer(<<?CR,?LF,?CR,?LF, Bin/binary>>, [], [], _, Body, BodyLength) ->
+ {ok, {["content-length:" ++ BodyLength], <<Body/binary, Bin/binary>>}};
+decode_trailer(<<?CR,?LF,?CR,?LF, Bin/binary>>,
+ Header, Headers, MaxHeaderSize, Body, BodyLength) ->
+ NewHeaders = case Header of
+ [] ->
+ Headers;
+ _ ->
+ [lists:reverse(Header) | Headers]
+ end,
+ Length = length(NewHeaders),
+ case Length > MaxHeaderSize of
+ true ->
+ throw({error, {header_too_long, MaxHeaderSize,
+ MaxHeaderSize-Length}});
+ false ->
+ {ok, {["content-length:" ++ BodyLength | NewHeaders],
+ <<Body/binary, Bin/binary>>}}
+ end;
+decode_trailer(<<?CR,?LF,?CR>> = Data, Header, Headers, MaxHeaderSize,
+ Body, BodyLength) ->
+ {?MODULE, decode_trailer, [Data, Header, Headers, MaxHeaderSize, Body,
+ BodyLength]};
+decode_trailer(<<?CR,?LF>> = Data, Header, Headers, MaxHeaderSize,
+ Body, BodyLength) ->
+ {?MODULE, decode_trailer, [Data, Header, Headers, MaxHeaderSize, Body,
+ BodyLength]};
+decode_trailer(<<?CR>> = Data, Header, Headers, MaxHeaderSize,
+ Body, BodyLength) ->
+ {?MODULE, decode_trailer, [Data, Header, Headers, MaxHeaderSize, Body,
+ BodyLength]};
+decode_trailer(<<?CR, ?LF, Rest/binary>>, Header, Headers,
+ MaxHeaderSize, Body, BodyLength) ->
+ decode_trailer(Rest, [], [lists:reverse(Header) | Headers],
+ MaxHeaderSize, Body, BodyLength);
+
+decode_trailer(<<Octet, Rest/binary>>, Header, Headers, MaxHeaderSize, Body,
+ BodyLength) ->
+ decode_trailer(Rest, [Octet | Header], Headers, MaxHeaderSize,
+ Body, BodyLength).
+
+stream(BodyPart, false) ->
+ {BodyPart, false};
+stream(BodyPart, {Code, Request}) ->
+ {NewBody, NewRequest} = httpc_handler:stream(BodyPart, Request, Code),
+ {NewBody, {Code, NewRequest}}.
Added: incubator/couchdb/trunk/src/couch_inets/http_cookie.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/http_cookie.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/http_cookie.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/http_cookie.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,389 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%% Description: Cookie handling according to RFC 2109
+
+-module(http_cookie).
+
+-include("httpc_internal.hrl").
+
+-export([header/4, cookies/3, open_cookie_db/1, close_cookie_db/1, insert/2]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+header(Scheme, {Host, _}, Path, CookieDb) ->
+ case lookup_cookies(Host, Path, CookieDb) of
+ [] ->
+ {"cookie", ""};
+ Cookies ->
+ {"cookie", cookies_to_string(Scheme, Cookies)}
+ end.
+
+cookies(Headers, RequestPath, RequestHost) ->
+ Cookies = parse_set_cookies(Headers, {RequestPath, RequestHost}),
+ accept_cookies(Cookies, RequestPath, RequestHost).
+
+open_cookie_db({{_, only_session_cookies}, SessionDbName}) ->
+ EtsDb = ets:new(SessionDbName, [protected, bag,
+ {keypos, #http_cookie.domain}]),
+ {undefined, EtsDb};
+
+open_cookie_db({{DbName, Dbdir}, SessionDbName}) ->
+ File = filename:join(Dbdir, atom_to_list(DbName)),
+ {ok, DetsDb} = dets:open_file(DbName, [{keypos, #http_cookie.domain},
+ {type, bag},
+ {file, File},
+ {ram_file, true}]),
+ EtsDb = ets:new(SessionDbName, [protected, bag,
+ {keypos, #http_cookie.domain}]),
+ {DetsDb, EtsDb}.
+
+close_cookie_db({undefined, EtsDb}) ->
+ ets:delete(EtsDb);
+
+close_cookie_db({DetsDb, EtsDb}) ->
+ dets:close(DetsDb),
+ ets:delete(EtsDb).
+
+%% If no persistent cookie database is defined we
+%% treat all cookies as if they where session cookies.
+insert(Cookie = #http_cookie{max_age = Int},
+ Dbs = {undefined, _}) when is_integer(Int) ->
+ insert(Cookie#http_cookie{max_age = session}, Dbs);
+
+insert(Cookie = #http_cookie{domain = Key, name = Name,
+ path = Path, max_age = session},
+ Db = {_, CookieDb}) ->
+ case ets:match_object(CookieDb, #http_cookie{domain = Key,
+ name = Name,
+ path = Path,
+ _ = '_'}) of
+ [] ->
+ ets:insert(CookieDb, Cookie);
+ [NewCookie] ->
+ delete(NewCookie, Db),
+ ets:insert(CookieDb, Cookie)
+ end,
+ ok;
+insert(#http_cookie{domain = Key, name = Name,
+ path = Path, max_age = 0},
+ Db = {CookieDb, _}) ->
+ case dets:match_object(CookieDb, #http_cookie{domain = Key,
+ name = Name,
+ path = Path,
+ _ = '_'}) of
+ [] ->
+ ok;
+ [NewCookie] ->
+ delete(NewCookie, Db)
+ end,
+ ok;
+insert(Cookie = #http_cookie{domain = Key, name = Name, path = Path},
+ Db = {CookieDb, _}) ->
+ case dets:match_object(CookieDb, #http_cookie{domain = Key,
+ name = Name,
+ path = Path,
+ _ = '_'}) of
+ [] ->
+ dets:insert(CookieDb, Cookie);
+ [NewCookie] ->
+ delete(NewCookie, Db),
+ dets:insert(CookieDb, Cookie)
+ end,
+ ok.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+lookup_cookies(Key, {undefined, Ets}) ->
+ ets:match_object(Ets, #http_cookie{domain = Key,
+ _ = '_'});
+lookup_cookies(Key, {Dets,Ets}) ->
+ SessionCookies = ets:match_object(Ets, #http_cookie{domain = Key,
+ _ = '_'}),
+ Cookies = dets:match_object(Dets, #http_cookie{domain = Key,
+ _ = '_'}),
+ Cookies ++ SessionCookies.
+
+delete(Cookie = #http_cookie{max_age = session}, {_, CookieDb}) ->
+ ets:delete_object(CookieDb, Cookie);
+delete(Cookie, {CookieDb, _}) ->
+ dets:delete_object(CookieDb, Cookie).
+
+lookup_cookies(Host, Path, Db) ->
+ Cookies =
+ case http_util:is_hostname(Host) of
+ true ->
+ HostCookies = lookup_cookies(Host, Db),
+ [_| DomainParts] = string:tokens(Host, "."),
+ lookup_domain_cookies(DomainParts, Db, HostCookies);
+ false -> % IP-adress
+ lookup_cookies(Host, Db)
+ end,
+ ValidCookies = valid_cookies(Cookies, [], Db),
+ lists:filter(fun(Cookie) ->
+ lists:prefix(Cookie#http_cookie.path, Path)
+ end, ValidCookies).
+
+%% For instance if Host=localhost
+lookup_domain_cookies([], _, AccCookies) ->
+ lists:flatten(AccCookies);
+%% Top domains can not have cookies
+lookup_domain_cookies([_], _, AccCookies) ->
+ lists:flatten(AccCookies);
+lookup_domain_cookies([Next | DomainParts], CookieDb, AccCookies) ->
+ Domain = merge_domain_parts(DomainParts, [Next ++ "."]),
+ lookup_domain_cookies(DomainParts, CookieDb,
+ [lookup_cookies(Domain, CookieDb)
+ | AccCookies]).
+
+merge_domain_parts([Part], Merged) ->
+ lists:flatten(["." | lists:reverse([Part | Merged])]);
+merge_domain_parts([Part| Rest], Merged) ->
+ merge_domain_parts(Rest, [".", Part | Merged]).
+
+cookies_to_string(Scheme, Cookies = [Cookie | _]) ->
+ Version = "$Version=" ++ Cookie#http_cookie.version ++ "; ",
+ cookies_to_string(Scheme, path_sort(Cookies), [Version]).
+
+cookies_to_string(_, [], CookieStrs) ->
+ case length(CookieStrs) of
+ 1 ->
+ "";
+ _ ->
+ lists:flatten(lists:reverse(CookieStrs))
+ end;
+
+cookies_to_string(https, [Cookie = #http_cookie{secure = true}| Cookies],
+ CookieStrs) ->
+ Str = case Cookies of
+ [] ->
+ cookie_to_string(Cookie);
+ _ ->
+ cookie_to_string(Cookie) ++ "; "
+ end,
+ cookies_to_string(https, Cookies, [Str | CookieStrs]);
+
+cookies_to_string(Scheme, [#http_cookie{secure = true}| Cookies],
+ CookieStrs) ->
+ cookies_to_string(Scheme, Cookies, CookieStrs);
+
+cookies_to_string(Scheme, [Cookie | Cookies], CookieStrs) ->
+ Str = case Cookies of
+ [] ->
+ cookie_to_string(Cookie);
+ _ ->
+ cookie_to_string(Cookie) ++ "; "
+ end,
+ cookies_to_string(Scheme, Cookies, [Str | CookieStrs]).
+
+cookie_to_string(Cookie = #http_cookie{name = Name, value = Value}) ->
+ Str = Name ++ "=" ++ Value,
+ add_domain(add_path(Str, Cookie), Cookie).
+
+add_path(Str, #http_cookie{path_default = true}) ->
+ Str;
+add_path(Str, #http_cookie{path = Path}) ->
+ Str ++ "; $Path=" ++ Path.
+
+add_domain(Str, #http_cookie{domain_default = true}) ->
+ Str;
+add_domain(Str, #http_cookie{domain = Domain}) ->
+ Str ++ "; $Domain=" ++ Domain.
+
+parse_set_cookies(OtherHeaders, DefaultPathDomain) ->
+ SetCookieHeaders = lists:foldl(fun({"set-cookie", Value}, Acc) ->
+ [string:tokens(Value, ",")| Acc];
+ (_, Acc) ->
+ Acc
+ end, [], OtherHeaders),
+
+ lists:flatten(lists:map(fun(CookieHeader) ->
+ NewHeader =
+ fix_netscape_cookie(CookieHeader,
+ []),
+ parse_set_cookie(NewHeader, [],
+ DefaultPathDomain) end,
+ SetCookieHeaders)).
+
+parse_set_cookie([], AccCookies, _) ->
+ AccCookies;
+parse_set_cookie([CookieHeader | CookieHeaders], AccCookies,
+ Defaults = {DefaultPath, DefaultDomain}) ->
+ [CookieStr | Attributes] = case string:tokens(CookieHeader, ";") of
+ [CStr] ->
+ [CStr, ""];
+ [CStr | Attr] ->
+ [CStr, Attr]
+ end,
+ Pos = string:chr(CookieStr, $=),
+ Name = string:substr(CookieStr, 1, Pos - 1),
+ Value = string:substr(CookieStr, Pos + 1),
+ Cookie = #http_cookie{name = string:strip(Name),
+ value = string:strip(Value)},
+ NewAttributes = parse_set_cookie_attributes(Attributes),
+ TmpCookie = cookie_attributes(NewAttributes, Cookie),
+ %% Add runtime defult values if necessary
+ NewCookie = domain_default(path_default(TmpCookie, DefaultPath),
+ DefaultDomain),
+ parse_set_cookie(CookieHeaders, [NewCookie | AccCookies], Defaults).
+
+parse_set_cookie_attributes([]) ->
+ [];
+parse_set_cookie_attributes([Attributes]) ->
+ lists:map(fun(Attr) ->
+ [AttrName, AttrValue] =
+ case string:tokens(Attr, "=") of
+ %% All attributes have the form
+ %% Name=Value except "secure"!
+ [Name] ->
+ [Name, ""];
+ [Name, Value] ->
+ [Name, Value];
+ %% Anything not expected will be
+ %% disregarded
+ _ ->
+ ["Dummy",""]
+ end,
+ {http_util:to_lower(string:strip(AttrName)),
+ string:strip(AttrValue)}
+ end, Attributes).
+
+cookie_attributes([], Cookie) ->
+ Cookie;
+cookie_attributes([{"comment", Value}| Attributes], Cookie) ->
+ cookie_attributes(Attributes,
+ Cookie#http_cookie{comment = Value});
+cookie_attributes([{"domain", Value}| Attributes], Cookie) ->
+ cookie_attributes(Attributes,
+ Cookie#http_cookie{domain = Value});
+cookie_attributes([{"max-age", Value}| Attributes], Cookie) ->
+ ExpireTime = cookie_expires(list_to_integer(Value)),
+ cookie_attributes(Attributes,
+ Cookie#http_cookie{max_age = ExpireTime});
+%% Backwards compatibility with netscape cookies
+cookie_attributes([{"expires", Value}| Attributes], Cookie) ->
+ Time = http_util:convert_netscapecookie_date(Value),
+ ExpireTime = calendar:datetime_to_gregorian_seconds(Time),
+ cookie_attributes(Attributes,
+ Cookie#http_cookie{max_age = ExpireTime});
+cookie_attributes([{"path", Value}| Attributes], Cookie) ->
+ cookie_attributes(Attributes,
+ Cookie#http_cookie{path = Value});
+cookie_attributes([{"secure", _}| Attributes], Cookie) ->
+ cookie_attributes(Attributes,
+ Cookie#http_cookie{secure = true});
+cookie_attributes([{"version", Value}| Attributes], Cookie) ->
+ cookie_attributes(Attributes,
+ Cookie#http_cookie{version = Value});
+%% Disregard unknown attributes.
+cookie_attributes([_| Attributes], Cookie) ->
+ cookie_attributes(Attributes, Cookie).
+
+domain_default(Cookie = #http_cookie{domain = undefined},
+ DefaultDomain) ->
+ Cookie#http_cookie{domain = DefaultDomain, domain_default = true};
+domain_default(Cookie, _) ->
+ Cookie.
+
+path_default(Cookie = #http_cookie{path = undefined},
+ DefaultPath) ->
+ Cookie#http_cookie{path = skip_right_most_slash(DefaultPath),
+ path_default = true};
+path_default(Cookie, _) ->
+ Cookie.
+
+%% Note: if the path is only / that / will be keept
+skip_right_most_slash("/") ->
+ "/";
+skip_right_most_slash(Str) ->
+ string:strip(Str, right, $/).
+
+accept_cookies(Cookies, RequestPath, RequestHost) ->
+ lists:filter(fun(Cookie) ->
+ accept_cookie(Cookie, RequestPath, RequestHost)
+ end, Cookies).
+
+accept_cookie(Cookie, RequestPath, RequestHost) ->
+ accept_path(Cookie, RequestPath) and accept_domain(Cookie, RequestHost).
+
+accept_path(#http_cookie{path = Path}, RequestPath) ->
+ lists:prefix(Path, RequestPath).
+
+accept_domain(#http_cookie{domain = RequestHost}, RequestHost) ->
+ true;
+
+accept_domain(#http_cookie{domain = Domain}, RequestHost) ->
+ HostCheck = case http_util:is_hostname(RequestHost) of
+ true ->
+ (lists:suffix(Domain, RequestHost) andalso
+ (not
+ lists:member($.,
+ string:substr(RequestHost, 1,
+ (length(RequestHost) -
+ length(Domain))))));
+ false ->
+ false
+ end,
+ HostCheck andalso (hd(Domain) == $.)
+ andalso (length(string:tokens(Domain, ".")) > 1).
+
+cookie_expires(0) ->
+ 0;
+cookie_expires(DeltaSec) ->
+ NowSec = calendar:datetime_to_gregorian_seconds({date(), time()}),
+ NowSec + DeltaSec.
+
+is_cookie_expired(#http_cookie{max_age = session}) ->
+ false;
+is_cookie_expired(#http_cookie{max_age = ExpireTime}) ->
+ NowSec = calendar:datetime_to_gregorian_seconds({date(), time()}),
+ ExpireTime - NowSec =< 0.
+
+valid_cookies([], Valid, _) ->
+ Valid;
+
+valid_cookies([Cookie | Cookies], Valid, Db) ->
+ case is_cookie_expired(Cookie) of
+ true ->
+ delete(Cookie, Db),
+ valid_cookies(Cookies, Valid, Db);
+ false ->
+ valid_cookies(Cookies, [Cookie | Valid], Db)
+ end.
+
+path_sort(Cookies)->
+ lists:reverse(lists:keysort(#http_cookie.path, Cookies)).
+
+
+%% Informally, the Set-Cookie response header comprises the token
+%% Set-Cookie:, followed by a comma-separated list of one or more
+%% cookies. Netscape cookies expires attribute may also have a
+%% , in this case the header list will have been incorrectly split
+%% in parse_set_cookies/2 this functions fixs that problem.
+fix_netscape_cookie([Cookie1, Cookie2 | Rest], Acc) ->
+ case regexp:match(Cookie1, "expires=") of
+ {_, _, _} ->
+ fix_netscape_cookie(Rest, [Cookie1 ++ Cookie2 | Acc]);
+ nomatch ->
+ fix_netscape_cookie([Cookie2 |Rest], [Cookie1| Acc])
+ end;
+fix_netscape_cookie([Cookie | Rest], Acc) ->
+ fix_netscape_cookie(Rest, [Cookie | Acc]);
+
+fix_netscape_cookie([], Acc) ->
+ Acc.
Added: incubator/couchdb/trunk/src/couch_inets/http_internal.hrl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/http_internal.hrl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/http_internal.hrl (added)
+++ incubator/couchdb/trunk/src/couch_inets/http_internal.hrl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,105 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+
+-include("inets_internal.hrl").
+
+-define(HTTP_MAX_BODY_SIZE, nolimit).
+-define(HTTP_MAX_HEADER_SIZE, 10240).
+
+%%% Response headers
+-record(http_response_h,{
+%%% --- Standard "General" headers
+ 'cache-control',
+ connection,
+ date,
+ pragma,
+ trailer,
+ 'transfer-encoding',
+ upgrade,
+ via,
+ warning,
+%%% --- Standard "Response" headers
+ 'accept-ranges',
+ age,
+ etag,
+ location,
+ 'proxy-authenticate',
+ 'retry-after',
+ server,
+ vary,
+ 'www-authenticate',
+%%% --- Standard "Entity" headers
+ allow,
+ 'content-encoding',
+ 'content-language',
+ 'content-length' = "-1",
+ 'content-location',
+ 'content-md5',
+ 'content-range',
+ 'content-type',
+ expires,
+ 'last-modified',
+ other=[] % list() - Key/Value list with other headers
+ }).
+
+
+%%% Request headers
+-record(http_request_h,{
+%%% --- Standard "General" headers
+ 'cache-control',
+ connection = "keep-alive",
+ date,
+ pragma,
+ trailer,
+ 'transfer-encoding',
+ upgrade,
+ via,
+ warning,
+%%% --- Standard "Request" headers
+ accept,
+ 'accept-charset',
+ 'accept-encoding',
+ 'accept-language',
+ authorization,
+ expect,
+ from,
+ host,
+ 'if-match',
+ 'if-modified-since',
+ 'if-none-match',
+ 'if-range',
+ 'if-unmodified-since',
+ 'max-forwards',
+ 'proxy-authorization',
+ range,
+ referer,
+ te,
+ 'user-agent',
+%%% --- Standard "Entity" headers
+ allow,
+ 'content-encoding',
+ 'content-language',
+ 'content-length' = "0",
+ 'content-location',
+ 'content-md5',
+ 'content-range',
+ 'content-type',
+ expires,
+ 'last-modified',
+ other=[] % list() - Key/Value list with other headers
+ }).
Added: incubator/couchdb/trunk/src/couch_inets/http_request.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/http_request.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/http_request.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/http_request.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,278 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+
+-module(http_request).
+
+-include("http_internal.hrl").
+
+-export([headers/2, http_headers/1, is_absolut_uri/1]).
+
+%%-------------------------------------------------------------------------
+%% headers(HeaderList, #http_request_h{}) -> #http_request_h{}
+%% HeaderList - ["HeaderField:Value"]
+%% HeaderField - string()
+%% Value - string()
+%%
+%% Description: Creates a http_request_h-record used internally to
+%% handle http-headers.
+%%-------------------------------------------------------------------------
+headers([], Headers) ->
+ Headers;
+headers([Header | Tail], Headers) ->
+ case lists:splitwith(fun($:) -> false; (_) -> true end, Header) of
+ {Key, [$: | Value]} ->
+ headers(Tail, headers(http_util:to_lower(string:strip(Key)),
+ string:strip(Value), Headers));
+ {_, []} ->
+ error_logger:error_report("Ignored invalid HTTP-header: ~p~n",
+ [Header]),
+ headers(Tail, Headers)
+ end.
+
+%%-------------------------------------------------------------------------
+%% headers(#http_request_h{}) -> HeaderList
+%% HeaderList - ["HeaderField:Value"]
+%% HeaderField - string()
+%% Value - string()
+%%
+%% Description: Creates a HTTP header string.
+%%-------------------------------------------------------------------------
+http_headers(Headers = #http_request_h{other = Other}) ->
+ HeaderFields = record_info(fields, http_request_h) -- [other],
+ HeaderStr = lists:foldl(fun(Key, Acc) ->
+ case key_value_str(Key, Headers) of
+ undefined ->
+ Acc;
+ Str ->
+ [Str | Acc]
+ end
+ end,
+ [], HeaderFields),
+
+ lists:flatten([HeaderStr | headers_other(Other, [])]).
+
+%%-------------------------------------------------------------------------
+%% is_absolut_uri(URI) -> true | false
+%% URI - string()
+%%
+%% Description: Checks if an URI is absolute or relative
+%%-------------------------------------------------------------------------
+is_absolut_uri("http://" ++ _) ->
+ true;
+is_absolut_uri("https://" ++ _) ->
+ true;
+is_absolut_uri(_) ->
+ false.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
+%%% --- Request headers
+headers("accept", Value, Headers) ->
+ Headers#http_request_h{accept = Value};
+headers("accept-charset", Value, Headers) ->
+ Headers#http_request_h{'accept-charset' = Value};
+headers("accept-encoding", Value, Headers) ->
+ Headers#http_request_h{'accept-encoding' = Value};
+headers("accept-language", Value, Headers) ->
+ Headers#http_request_h{'accept-language' = Value};
+headers("authorization", Value, Headers) ->
+ Headers#http_request_h{authorization = Value};
+headers("expect", Value, Headers) ->
+ Headers#http_request_h{expect = Value};
+headers("from", Value, Headers) ->
+ Headers#http_request_h{from = Value};
+headers("host", Value, Headers) ->
+ Headers#http_request_h{host = Value};
+headers("if-match", Value, Headers) ->
+ Headers#http_request_h{'if-match' = Value};
+headers("if-modified-since", Value, Headers) ->
+ Headers#http_request_h{'if-modified-since' = Value};
+headers("if-none-match", Value, Headers) ->
+ Headers#http_request_h{'if-none-match' = Value};
+headers("if-range", Value, Headers) ->
+ Headers#http_request_h{'if-range' = Value};
+headers("if-unmodified-since", Value, Headers) ->
+ Headers#http_request_h{'if-unmodified-since' = Value};
+headers("max-forwards", Value, Headers) ->
+ Headers#http_request_h{'max-forwards' = Value};
+headers("proxy-authorization", Value, Headers) ->
+ Headers#http_request_h{'proxy-authorization' = Value};
+headers("range", Value, Headers) ->
+ Headers#http_request_h{range = Value};
+headers("referer", Value, Headers) ->
+ Headers#http_request_h{referer = Value};
+headers("te", Value, Headers) ->
+ Headers#http_request_h{te = Value};
+headers("user-agent", Value, Headers) ->
+ Headers#http_request_h{'user-agent' = Value};
+
+%% General-Headers
+headers("cache-control", Value, Headers) ->
+ Headers#http_request_h{'cache-control' = Value};
+headers("connection", Value, Headers) ->
+ Headers#http_request_h{connection = Value};
+headers("date", Value, Headers) ->
+ Headers#http_request_h{date = Value};
+headers("pragma", Value, Headers) ->
+ Headers#http_request_h{pragma = Value};
+headers("trailer", Value, Headers) ->
+ Headers#http_request_h{trailer = Value};
+headers("transfer-encoding", Value, Headers) ->
+ Headers#http_request_h{'transfer-encoding' = Value};
+headers("upgrade", Value, Headers) ->
+ Headers#http_request_h{upgrade = Value};
+headers("via", Value, Headers) ->
+ Headers#http_request_h{via = Value};
+headers("warning", Value, Headers) ->
+ Headers#http_request_h{warning = Value};
+
+%% Entity header
+headers("allow", Value, Headers) ->
+ Headers#http_request_h{allow = Value};
+headers("content-encoding", Value, Headers) ->
+ Headers#http_request_h{'content-encoding' = Value};
+headers("content-language", Value, Headers) ->
+ Headers#http_request_h{'content-language' = Value};
+headers("content-length", Value, Headers) ->
+ Headers#http_request_h{'content-length' = Value};
+headers("content-location", Value, Headers) ->
+ Headers#http_request_h{'content-location' = Value};
+headers("content-md5", Value, Headers) ->
+ Headers#http_request_h{'content-md5' = Value};
+headers("content-range", Value, Headers) ->
+ Headers#http_request_h{'content-range' = Value};
+headers("content-type", Value, Headers) ->
+ Headers#http_request_h{'content-type' = Value};
+headers("expires", Value, Headers) ->
+ Headers#http_request_h{expires = Value};
+headers("last-modified", Value, Headers) ->
+ Headers#http_request_h{'last-modified' = Value};
+headers(Key, Value, Headers) ->
+ Headers#http_request_h{other=
+ [{Key, Value} | Headers#http_request_h.other]}.
+
+key_value_str(Key = 'cache-control', Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.'cache-control');
+key_value_str(Key = connection, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.connection);
+key_value_str(Key = date, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.date);
+key_value_str(Key = pragma, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.pragma);
+key_value_str(Key = trailer, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.trailer);
+key_value_str(Key = 'transfer-encoding', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'transfer-encoding');
+key_value_str(Key = upgrade, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.upgrade);
+key_value_str(Key = via, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.via);
+key_value_str(Key = warning, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.warning);
+key_value_str(Key = accept, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.accept);
+key_value_str(Key = 'accept-charset', Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.'accept-charset');
+key_value_str(Key = 'accept-encoding', Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.'accept-encoding');
+key_value_str(Key = 'accept-language', Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.'accept-language');
+key_value_str(Key = authorization, Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.authorization);
+key_value_str(Key = expect, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.expect);
+key_value_str(Key = from, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.from);
+key_value_str(Key = host, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.host);
+key_value_str(Key = 'if-match', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'if-match');
+key_value_str(Key = 'if-modified-since', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'if-modified-since');
+key_value_str(Key = 'if-none-match', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'if-none-match');
+key_value_str(Key = 'if-range', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'if-range');
+key_value_str(Key = 'if-unmodified-since', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'if-unmodified-since');
+key_value_str(Key = 'max-forwards', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'max-forwards');
+key_value_str(Key = 'proxy-authorization', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'proxy-authorization');
+key_value_str(Key = range, Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.range);
+key_value_str(Key = referer, Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.referer);
+key_value_str(Key = te, Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.te);
+key_value_str(Key = 'user-agent', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'user-agent');
+key_value_str(Key = allow, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.allow);
+key_value_str(Key = 'content-encoding', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'content-encoding');
+key_value_str(Key = 'content-language', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'content-language');
+key_value_str(Key = 'content-length', Headers) ->
+ case Headers#http_request_h.'content-length' of
+ "0" ->
+ undefined;
+ _ ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'content-length')
+ end;
+key_value_str(Key = 'content-location', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'content-location');
+key_value_str(Key = 'content-md5', Headers) ->
+ key_value_str(atom_to_list(Key),
+ Headers#http_request_h.'content-md5');
+key_value_str(Key = 'content-range', Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.'content-range');
+key_value_str(Key = 'content-type', Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.'content-type');
+key_value_str(Key = expires, Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.expires);
+key_value_str(Key = 'last-modified', Headers) ->
+ key_value_str(atom_to_list(Key), Headers#http_request_h.'last-modified');
+key_value_str(_, undefined) ->
+ undefined;
+key_value_str(Key, Value) ->
+ Key ++ ": " ++ Value ++ ?CRLF.
+
+headers_other([], Headers) ->
+ Headers;
+headers_other([{Key,Value} | Rest], Headers) ->
+ Header = Key ++ ": " ++ Value ++ ?CRLF,
+ headers_other(Rest, [Header | Headers]).
Added: incubator/couchdb/trunk/src/couch_inets/http_response.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/http_response.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/http_response.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/http_response.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,206 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+
+-module(http_response).
+
+-include("http_internal.hrl").
+
+-export([headers/2, header_list/1]).
+
+%%-------------------------------------------------------------------------
+%% headers(HeaderList, #http_response_h{}) -> #http_response_h{}
+%% HeaderList - ["HeaderField:Value"]
+%% HeaderField - string()
+%% Value - string()
+%%
+%% Description: Creates a http_response_h-record used internally to
+%% handle http-headers.
+%%-------------------------------------------------------------------------
+headers([], Headers) ->
+ Headers;
+
+headers([Header | Tail], Headers) ->
+ {Key, [$: | Value]} =
+ lists:splitwith(fun($:) -> false; (_) -> true end, Header),
+ headers(Tail, headers(http_util:to_lower(string:strip(Key)),
+ string:strip(Value), Headers)).
+
+%%-------------------------------------------------------------------------
+%% headers(#http_response_h{}) -> HeaderList
+%% HeaderList - [{"HeaderField", Value"}]
+%% HeaderField - string()
+%% Value - string()
+%%
+%% Description: Creates a list of key value tuples from the #http_response_h
+%% record, to be returned to the application programmer. We
+%% do not wish to make the application programmer dependent on
+%% our records.
+%%-------------------------------------------------------------------------
+header_list(Headers) ->
+ HeaderFields = record_info(fields, http_response_h) -- [other],
+ HeaderList = lists:foldl(fun(Key, Acc) ->
+ case key_value_tuple(Key, Headers) of
+ undefined ->
+ Acc;
+ Tuple ->
+ [Tuple | Acc]
+ end
+ end,
+ [], HeaderFields),
+ lists:reverse(HeaderList) ++ Headers#http_response_h.other.
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+headers("cache-control", Value, Headers) ->
+ Headers#http_response_h{'cache-control'= Value};
+headers("connection", Value, Headers) ->
+ Headers#http_response_h{connection = Value};
+headers("date", Value, Headers) ->
+ Headers#http_response_h{date = Value};
+headers("pragma", Value, Headers) ->
+ Headers#http_response_h{pragma = Value};
+headers("trailer", Value, Headers) ->
+ Headers#http_response_h{trailer = Value};
+headers("transfer-encoding", Value, Headers) ->
+ Headers#http_response_h{'transfer-encoding' = Value};
+headers("upgrade", Value, Headers) ->
+ Headers#http_response_h{upgrade = Value};
+headers("via", Value, Headers) ->
+ Headers#http_response_h{via = Value};
+headers("warning", Value, Headers) ->
+ Headers#http_response_h{warning = Value};
+headers("accept-ranges", Value, Headers) ->
+ Headers#http_response_h{'accept-ranges' = Value};
+headers("age", Value, Headers) ->
+ Headers#http_response_h{age = Value};
+headers("etag", Value, Headers) ->
+ Headers#http_response_h{etag = Value};
+headers("location", Value, Headers) ->
+ Headers#http_response_h{location = Value};
+headers("proxy-authenticate", Value, Headers) ->
+ Headers#http_response_h{'proxy-authenticate' = Value};
+headers("retry-after", Value, Headers) ->
+ Headers#http_response_h{'retry-after' = Value};
+headers("server", Value, Headers) ->
+ Headers#http_response_h{server = Value};
+headers("vary", Value, Headers) ->
+ Headers#http_response_h{vary = Value};
+headers("www-authenticate", Value, Headers) ->
+ Headers#http_response_h{'www-authenticate' = Value};
+headers("allow", Value, Headers) ->
+ Headers#http_response_h{allow = Value};
+headers("content-encoding", Value, Headers) ->
+ Headers#http_response_h{'content-encoding' = Value};
+headers("content-language", Value, Headers) ->
+ Headers#http_response_h{'content-language' = Value};
+headers("content-length", Value, Headers) ->
+ Headers#http_response_h{'content-length' = Value};
+headers("content-location", Value, Headers) ->
+ Headers#http_response_h{'content-location' = Value};
+headers("content-md5", Value, Headers) ->
+ Headers#http_response_h{'content-md5' = Value};
+headers("content-range", Value, Headers) ->
+ Headers#http_response_h{'content-range' = Value};
+headers("content-type", Value, Headers) ->
+ Headers#http_response_h{'content-type' = Value};
+headers("expires", Value, Headers) ->
+ Headers#http_response_h{expires = Value};
+headers("last-modified", Value, Headers) ->
+ Headers#http_response_h{'last-modified' = Value};
+headers(Key, Value, Headers) ->
+ Headers#http_response_h{other=
+ [{Key, Value} | Headers#http_response_h.other]}.
+
+
+key_value_tuple(Key = 'cache-control', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'cache-control');
+key_value_tuple(Key = connection, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.connection);
+key_value_tuple(Key = date, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.date);
+key_value_tuple(Key = pragma, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.pragma);
+key_value_tuple(Key = trailer, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.trailer);
+key_value_tuple(Key ='transfer-encoding', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'transfer-encoding');
+key_value_tuple(Key = upgrade, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.upgrade);
+key_value_tuple(Key = via, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.via);
+key_value_tuple(Key = warning, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.warning);
+key_value_tuple(Key = 'accept-ranges', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'accept-ranges');
+key_value_tuple(Key = age, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.age);
+key_value_tuple(Key = etag, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.etag);
+key_value_tuple(Key = location, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.location);
+key_value_tuple(Key = 'proxy-authenticate', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'proxy-authenticate');
+key_value_tuple(Key = 'retry-after', Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.'retry-after');
+key_value_tuple(Key = server, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.server);
+key_value_tuple(Key = vary, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.vary);
+key_value_tuple(Key = 'www-authenticate', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'www-authenticate');
+key_value_tuple(Key = allow, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.allow);
+key_value_tuple(Key = 'content-encoding', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'content-encoding');
+key_value_tuple(Key = 'content-language', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'content-language');
+key_value_tuple(Key = 'content-length', Headers) ->
+ case Headers#http_response_h.'content-length' of
+ "-1" ->
+ undefined;
+ _ ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'content-length')
+ end;
+key_value_tuple(Key = 'content-location', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'content-location');
+key_value_tuple(Key = 'content-md5', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'content-md5');
+key_value_tuple(Key = 'content-range', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'content-range');
+key_value_tuple(Key = 'content-type', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'content-type');
+key_value_tuple(Key = expires, Headers) ->
+ key_value_tuple(atom_to_list(Key), Headers#http_response_h.expires);
+key_value_tuple(Key = 'last-modified', Headers) ->
+ key_value_tuple(atom_to_list(Key),
+ Headers#http_response_h.'last-modified');
+key_value_tuple(_, undefined) ->
+ undefined;
+key_value_tuple(Key, Value) ->
+ {Key, Value}.
Added: incubator/couchdb/trunk/src/couch_inets/http_transport.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/http_transport.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/http_transport.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/http_transport.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,291 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%
+-module(http_transport).
+
+% Internal application API
+-export([start/1, connect/3, connect/4, listen/2, listen/3,
+ accept/2, accept/3, close/2,
+ send/3, controlling_process/3, setopts/3,
+ peername/2, resolve/0]).
+
+%%%=========================================================================
+%%% Internal application API
+%%%=========================================================================
+
+%%-------------------------------------------------------------------------
+%% start(SocketType) -> ok | {error, Reason}
+%% SocketType = ip_comm | {ssl, _}
+%%
+%% Description: Makes sure inet_db or ssl is started.
+%%-------------------------------------------------------------------------
+start(ip_comm) ->
+ case inet_db:start() of
+ {ok, _} ->
+ ok;
+ {error, {already_started, _}} ->
+ ok;
+ Error ->
+ Error
+ end;
+start({ssl, _}) ->
+ case ssl:start() of
+ ok ->
+ ok;
+ {ok, _} ->
+ ok;
+ {error, {already_started,_}} ->
+ ok;
+ Error ->
+ Error
+ end.
+
+%%-------------------------------------------------------------------------
+%% connect(SocketType, Address, IPV6, Timeout) ->
+%% {ok, Socket} | {error, Reason}
+%% SocketType = ip_comm | {ssl, SslConfig}
+%% Address = {Host, Port}
+%% IPV6 = disabled | enabled
+%% Socket = socket()
+%%
+%% Description: Connects to the Host and Port specified in HTTPRequest.
+%% uses ipv6 if possible.
+%%-------------------------------------------------------------------------
+connect(SocketType, Address, IPV6) ->
+ connect(SocketType, Address, IPV6, infinity).
+
+connect(ip_comm, {Host, Port}, enabled, Timeout) ->
+ {Opts, NewHost} =
+ case inet:getaddr(Host, inet6) of
+ {ok, IPAddr = {0, 0, 0, 0, 0, 16#ffff, _, _}} ->
+ case inet:getaddr(Host, inet) of
+ {ok,NewIP} ->
+ {[binary, {packet, 0}, {active, false},
+ {reuseaddr,true}], NewIP};
+ _Error ->
+ {[binary, {packet, 0}, {active, false},
+ {reuseaddr,true}, inet6], IPAddr}
+ end;
+ {ok, IPAddr} ->
+ {[binary, {packet, 0}, {active, false},
+ {reuseaddr,true}, inet6], IPAddr};
+ _ ->
+ {[binary, {packet, 0}, {active, false},
+ {reuseaddr,true}], Host}
+ end,
+ gen_tcp:connect(NewHost, Port, Opts, Timeout);
+
+connect(ip_comm, {Host, Port}, disabled, Timeout) ->
+ Opts = [binary, {packet, 0}, {active, false}, {reuseaddr,true}],
+ gen_tcp:connect(Host, Port, Opts, Timeout);
+
+connect({ssl, SslConfig}, {Host, Port}, _, Timeout) ->
+ Opts = [binary, {active, false}] ++ SslConfig,
+ ssl:connect(Host, Port, Opts, Timeout).
+
+%%-------------------------------------------------------------------------
+%% listen(SocketType, Port) -> {ok, Socket} | {error, Reason}
+%% SocketType = ip_comm | {ssl, SSLConfig}
+%% Port = integer()
+%% Socket = socket()
+%%
+%% Description: Sets up socket to listen on the port Port on the local
+%% host using either gen_tcp or ssl. In the gen_tcp case the port
+%% might allready have been initiated by a wrapper-program and is
+%% given as an Fd that can be retrieved by init:get_argument. The
+%% reason for this to enable a HTTP-server not runnig as root to use
+%% port 80.
+%%-------------------------------------------------------------------------
+listen(SocketType, Port) ->
+ listen(SocketType, undefined, Port).
+
+listen(ip_comm, Addr, Port) ->
+ FdName = list_to_atom("httpd_" ++ integer_to_list(Port)),
+ {NewPort, Opt} =
+ case init:get_argument(FdName) of
+ {ok, [[FdStr]]} ->
+ Fd = list_to_integer(FdStr),
+ {0,
+ sock_opt(ip_comm, Addr, [{backlog, 128},
+ {reuseaddr,true}, {fd,Fd}, {nodelay, true}])};
+ error ->
+ {Port,
+ sock_opt(ip_comm, Addr,
+ [{backlog, 128}, {reuseaddr, true}, {nodelay, true}])}
+ end,
+ gen_tcp:listen(NewPort, Opt);
+
+listen({ssl, SSLConfig} = Ssl, Addr, Port) ->
+ Opt = sock_opt(Ssl, Addr, SSLConfig),
+ ssl:listen(Port, Opt).
+
+%%-------------------------------------------------------------------------
+%% accept(SocketType, ListenSocket) -> {ok, Socket} | {error, Reason}
+%% accept(SocketType, ListenSocket, Timeout) -> ok | {error, Reason}
+%% SocketType = ip_comm | {ssl, SSLConfig}
+%% ListenSocket = socket()
+%% Timeout = infinity | integer() >= 0
+%% Socket = socket()
+%%
+%% Description: Accepts an incoming connection request on a listen socket,
+%% using either gen_tcp or ssl.
+%%-------------------------------------------------------------------------
+accept(SocketType, ListenSocket) ->
+ accept(SocketType, ListenSocket, infinity).
+accept(ip_comm, ListenSocket, Timeout) ->
+ gen_tcp:accept(ListenSocket, Timeout);
+accept({ssl,_SSLConfig}, ListenSocket, Timeout) ->
+ ssl:accept(ListenSocket, Timeout).
+
+%%-------------------------------------------------------------------------
+%% controlling_process(SocketType, Socket, NewOwner) -> ok | {error, Reason}
+%% SocketType = ip_comm | {ssl, _}
+%% Socket = socket()
+%% NewOwner = pid()
+%%
+%% Description: Assigns a new controlling process to Socket.
+%%-------------------------------------------------------------------------
+controlling_process(ip_comm, Socket, NewOwner) ->
+ gen_tcp:controlling_process(Socket, NewOwner);
+controlling_process({ssl, _}, Socket, NewOwner) ->
+ ssl:controlling_process(Socket, NewOwner).
+
+%%-------------------------------------------------------------------------
+%% setopts(SocketType, Socket, Options) -> ok | {error, Reason}
+%% SocketType = ip_comm | {ssl, _}
+%% Socket = socket()
+%% Options = list()
+%% Description: Sets one or more options for a socket, using either
+%% gen_tcp or ssl.
+%%-------------------------------------------------------------------------
+setopts(ip_comm, Socket, Options) ->
+ inet:setopts(Socket,Options);
+setopts({ssl, _}, Socket, Options) ->
+ ssl:setopts(Socket, Options).
+
+%%-------------------------------------------------------------------------
+%% send(RequestOrSocketType, Socket, Message) -> ok | {error, Reason}
+%% SocketType = ip_comm | {ssl, _}
+%% Socket = socket()
+%% Message = list() | binary()
+%% Description: Sends a packet on a socket, using either gen_tcp or ssl.
+%%-------------------------------------------------------------------------
+send(ip_comm, Socket, Message) ->
+ gen_tcp:send(Socket, Message);
+send({ssl, _}, Socket, Message) ->
+ ssl:send(Socket, Message).
+
+%%-------------------------------------------------------------------------
+%% close(SocketType, Socket) -> ok | {error, Reason}
+%% SocketType = ip_comm | {ssl, _}
+%% Socket = socket()
+%%
+%% Description: Closes a socket, using either gen_tcp or ssl.
+%%-------------------------------------------------------------------------
+close(ip_comm, Socket) ->
+ gen_tcp:close(Socket);
+close({ssl, _}, Socket) ->
+ ssl:close(Socket).
+
+%%-------------------------------------------------------------------------
+%% peername(SocketType, Socket) -> ok | {error, Reason}
+%% SocketType = ip_comm | {ssl, _}
+%% Socket = socket()
+%%
+%% Description: Returns the address and port for the other end of a
+%% connection, usning either gen_tcp or ssl.
+%%-------------------------------------------------------------------------
+peername(ip_comm, Socket) ->
+ case inet:peername(Socket) of
+ {ok,{{A, B, C, D}, Port}} ->
+ PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++
+ integer_to_list(C)++"."++integer_to_list(D),
+ {Port, PeerName};
+ {ok,{{A, B, C, D, E, F, G, H}, Port}} ->
+ PeerName = http_util:integer_to_hexlist(A) ++ ":"++
+ http_util:integer_to_hexlist(B) ++ ":" ++
+ http_util:integer_to_hexlist(C) ++ ":" ++
+ http_util:integer_to_hexlist(D) ++ ":" ++
+ http_util:integer_to_hexlist(E) ++ ":" ++
+ http_util:integer_to_hexlist(F) ++ ":" ++
+ http_util:integer_to_hexlist(G) ++":"++
+ http_util:integer_to_hexlist(H),
+ {Port, PeerName};
+ {error, _} ->
+ {-1, "unknown"}
+ end;
+
+peername({ssl, _}, Socket) ->
+ case ssl:peername(Socket) of
+ {ok,{{A, B, C, D}, Port}} ->
+ PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++
+ integer_to_list(C)++"."++integer_to_list(D),
+ {Port, PeerName};
+ {error, _} ->
+ {-1, "unknown"}
+ end.
+
+%%-------------------------------------------------------------------------
+%% resolve() -> HostName
+%% HostName = string()
+%%
+%% Description: Returns the local hostname.
+%%-------------------------------------------------------------------------
+resolve() ->
+ {ok, Name} = inet:gethostname(),
+ Name.
+
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
+%% Address any comes from directive: BindAddress "*"
+sock_opt(ip_comm, any = Addr, Opt) ->
+ sock_opt1([{ip, Addr} | Opt]);
+sock_opt(ip_comm, undefined, Opt) ->
+ sock_opt1(Opt);
+sock_opt(_, any = Addr, Opt) ->
+ sock_opt2([{ip, Addr} | Opt]);
+sock_opt(_, undefined, Opt) ->
+ sock_opt2(Opt);
+sock_opt(_, Addr, Opt) when size(Addr) == 4 ->
+ sock_opt2([{ip, Addr} | Opt]);
+sock_opt(ip_comm, Addr, Opt) ->
+ sock_opt2([inet6, {ip, Addr} | Opt]);
+sock_opt(_, Addr, Opt) ->
+ sock_opt2([{ip, Addr} | Opt]).
+
+sock_opt1(Opt) ->
+ case has_inet6_supported() of
+ yes ->
+ sock_opt2([inet6 | Opt]);
+ no ->
+ sock_opt2(Opt)
+ end.
+
+sock_opt2(Opt) ->
+ [{packet, 0}, {active, false} | Opt].
+
+has_inet6_supported() ->
+ case (catch inet:getaddr("localhost", inet6)) of
+ {ok, {0, 0, 0, 0, 0, 16#ffff, _, _}} ->
+ no;
+ {ok,_} -> yes;
+ _ ->
+ no
+ end.