couchdb-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From cml...@apache.org
Subject 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...
Date Fri, 28 Mar 2008 23:32:30 GMT
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.



Mime
View raw message