couchdb-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From cml...@apache.org
Subject svn commit: r642432 [7/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/httpc_sup.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpc_sup.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpc_sup.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpc_sup.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,70 @@
+%% ``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(httpc_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/1]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%%  API
+%%%=========================================================================
+start_link(HttpcServices) ->
+    supervisor:start_link({local, ?MODULE}, ?MODULE, [HttpcServices]).
+
+%%%=========================================================================
+%%%  Supervisor callback
+%%%=========================================================================
+init([]) ->
+    init([[]]);
+init([HttpcServices]) ->
+    RestartStrategy = one_for_one,
+    MaxR = 10,
+    MaxT = 3600,
+    Children = child_spec(HttpcServices, []),
+    {ok, {{RestartStrategy, MaxR, MaxT}, Children}}.
+
+child_spec([], []) ->
+    [httpc_child_spec(default, only_session_cookies)];
+child_spec([], Acc) ->
+    Acc;
+child_spec([{httpc, {Profile, Dir}} | Rest], Acc) ->
+    case httpc_child_spec(Profile, Dir) of
+	{} ->
+	    child_spec(Rest, Acc);
+	Spec ->
+	    child_spec(Rest, [Spec | Acc])
+    end.
+
+%% Note currently only one profile is supported e.i. the default profile
+httpc_child_spec(default, Dir) ->
+    Name = httpc_manager,  
+    StartFunc = {httpc_manager, start_link, [{default, Dir}]},
+    Restart = permanent, 
+    Shutdown = 4000,
+    Modules = [httpc_manager],
+    Type = worker,
+    {Name, StartFunc, Restart, Shutdown, Type, Modules};
+httpc_child_spec(_,_) ->
+    {}.
+
+

Added: incubator/couchdb/trunk/src/couch_inets/httpd.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,516 @@
+%% ``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(httpd).
+
+-export([multi_start/1, multi_start_link/1,
+	 start/0, start/1, 
+	 start_link/0, start_link/1, 
+	 start_child/0,start_child/1,
+	 multi_stop/1,
+	 stop/0,stop/1,stop/2,
+	 stop_child/0,stop_child/1,stop_child/2,
+	 multi_restart/1,
+	 restart/0,restart/1,restart/2,
+	 parse_query/1]).
+
+%% Optional start related stuff...
+-export([load/1, load_mime_types/1, start2/1, start_link2/1, stop2/1]).
+
+%% Management stuff
+-export([block/0,block/1,block/2,block/3,block/4,
+	 unblock/0,unblock/1,unblock/2]).
+
+%% Debugging and status info stuff...
+-export([get_status/1,get_status/2,get_status/3,
+	 get_admin_state/0,get_admin_state/1,get_admin_state/2,
+	 get_usage_state/0,get_usage_state/1,get_usage_state/2]).
+
+-include("httpd.hrl").
+
+start() ->
+    start("/var/tmp/server_root/conf/5984.conf").
+
+start(ConfigFile) ->
+    httpd_instance_sup:start(ConfigFile).
+
+start_link() ->
+    start("/var/tmp/server_root/conf/5984.conf").
+
+start_link(ConfigFile) when is_list(ConfigFile) ->
+    httpd_instance_sup:start_link(ConfigFile).
+
+start2(Config) when is_list(Config) ->
+    httpd_instance_sup:start2(Config).
+
+start_link2(Config) ->
+    httpd_instance_sup:start_link2(Config).
+
+stop() ->
+  stop(5984).
+
+stop(Port) when is_integer(Port) ->
+    stop(undefined, Port);
+stop(Pid) when is_pid(Pid) ->
+    httpd_instance_sup:stop(Pid);
+stop(ConfigFile) when is_list(ConfigFile) ->
+    httpd_instance_sup:stop(ConfigFile).
+
+stop(Addr, Port) when is_integer(Port) ->
+    httpd_instance_sup:stop(Addr, Port).
+
+stop2(Config) when is_list(Config) ->
+    httpd_instance_sup:stop2(Config).
+
+start_child() ->
+    start_child("/var/tmp/server_root/conf/5984.conf").
+
+start_child(ConfigFile) ->
+    httpd_sup:start_child(ConfigFile).
+
+stop_child() ->
+  stop_child(5984).
+
+stop_child(Port) ->
+    stop_child(undefined, Port).
+
+stop_child(Addr, Port) when integer(Port) ->
+    httpd_sup:stop_child(Addr, Port).
+
+multi_start(MultiConfigFile) ->
+    case read_multi_file(MultiConfigFile) of
+	{ok,ConfigFiles} ->
+	    mstart(ConfigFiles);
+	Error ->
+	    Error
+    end.
+
+mstart(ConfigFiles) ->
+    mstart(ConfigFiles,[]).
+mstart([],Results) ->
+    {ok,lists:reverse(Results)};
+mstart([H|T],Results) ->
+    Res = start(H),
+    mstart(T,[Res|Results]).
+
+multi_start_link(MultiConfigFile) ->
+    case read_multi_file(MultiConfigFile) of
+	{ok,ConfigFiles} ->
+	    mstart_link(ConfigFiles);
+	Error ->
+	    Error
+    end.
+mstart_link(ConfigFiles) ->
+    mstart_link(ConfigFiles,[]).
+mstart_link([],Results) ->
+    {ok,lists:reverse(Results)};
+mstart_link([H|T],Results) ->
+    Res = start_link(H),
+    mstart_link(T,[Res|Results]).
+
+multi_stop(MultiConfigFile) ->
+    case read_multi_file(MultiConfigFile) of
+	{ok,ConfigFiles} ->
+	    mstop(ConfigFiles);
+	Error ->
+	    Error
+    end.
+
+mstop(ConfigFiles) ->
+    mstop(ConfigFiles,[]).
+mstop([],Results) ->
+    {ok,lists:reverse(Results)};
+mstop([H|T],Results) ->
+    Res = stop(H),
+    mstop(T,[Res|Results]).
+
+multi_restart(MultiConfigFile) ->
+    case read_multi_file(MultiConfigFile) of
+	{ok,ConfigFiles} ->
+	    mrestart(ConfigFiles);
+	Error ->
+	    Error
+    end.
+
+mrestart(ConfigFiles) ->
+    mrestart(ConfigFiles,[]).
+mrestart([],Results) ->
+    {ok,lists:reverse(Results)};
+mrestart([H|T],Results) ->
+    Res = restart(H),
+    mrestart(T,[Res|Results]).
+
+restart() -> restart(undefined,5984).
+
+restart(Port) when is_integer(Port) ->
+    restart(undefined,Port);
+restart(ConfigFile) when is_list(ConfigFile) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok,Addr,Port} ->
+	    restart(Addr,Port);
+	Error ->
+	    Error
+    end.
+    
+restart(Addr,Port) when is_integer(Port) ->
+    do_restart(Addr,Port).
+
+do_restart(Addr,Port) when is_integer(Port) -> 
+    Name = make_name(Addr,Port),
+    case whereis(Name) of
+	Pid when pid(Pid) ->
+	    httpd_manager:restart(Pid);
+	_ ->
+	    {error,not_started}
+    end.
+    
+
+%%% =========================================================
+%%% Function:    block/0, block/1, block/2, block/3, block/4
+%%%              block()
+%%%              block(Port)
+%%%              block(ConfigFile)
+%%%              block(Addr,Port)
+%%%              block(Port,Mode)
+%%%              block(ConfigFile,Mode)
+%%%              block(Addr,Port,Mode)
+%%%              block(ConfigFile,Mode,Timeout)
+%%%              block(Addr,Port,Mode,Timeout)
+%%% 
+%%% Returns:     ok | {error,Reason}
+%%%              
+%%% Description: This function is used to block an HTTP server.
+%%%              The blocking can be done in two ways, 
+%%%              disturbing or non-disturbing. Default is disturbing.
+%%%              When a HTTP server is blocked, all requests are rejected
+%%%              (status code 503).
+%%% 
+%%%              disturbing:
+%%%              By performing a disturbing block, the server
+%%%              is blocked forcefully and all ongoing requests
+%%%              are terminated. No new connections are accepted.
+%%%              If a timeout time is given then, on-going requests
+%%%              are given this much time to complete before the
+%%%              server is forcefully blocked. In this case no new 
+%%%              connections is accepted.
+%%% 
+%%%              non-disturbing:
+%%%              A non-disturbing block is more gracefull. No
+%%%              new connections are accepted, but the ongoing 
+%%%              requests are allowed to complete.
+%%%              If a timeout time is given, it waits this long before
+%%%              giving up (the block operation is aborted and the 
+%%%              server state is once more not-blocked).
+%%%
+%%% Types:       Port       -> integer()             
+%%%              Addr       -> {A,B,C,D} | string() | undefined
+%%%              ConfigFile -> string()
+%%%              Mode       -> disturbing | non_disturbing
+%%%              Timeout    -> integer()
+%%%
+block() -> block(undefined,5984,disturbing).
+
+block(Port) when is_integer(Port) -> 
+    block(undefined,Port,disturbing);
+
+block(ConfigFile) when is_list(ConfigFile) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok,Addr,Port} ->
+	    block(Addr,Port,disturbing);
+	Error ->
+	    Error
+    end.
+
+block(Addr,Port) when is_integer(Port) -> 
+    block(Addr,Port,disturbing);
+
+block(Port,Mode) when is_integer(Port), is_atom(Mode) ->
+    block(undefined,Port,Mode);
+
+block(ConfigFile,Mode) when is_list(ConfigFile), is_atom(Mode) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok,Addr,Port} ->
+	    block(Addr,Port,Mode);
+	Error ->
+	    Error
+    end.
+
+
+block(Addr,Port,disturbing) when is_integer(Port) ->
+    do_block(Addr,Port,disturbing);
+block(Addr,Port,non_disturbing) when is_integer(Port) ->
+    do_block(Addr,Port,non_disturbing);
+
+block(ConfigFile,Mode,Timeout) when is_list(ConfigFile), is_atom(Mode), 
+				    is_integer(Timeout) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok,Addr,Port} ->
+	    block(Addr,Port,Mode,Timeout);
+	Error ->
+	    Error
+    end.
+
+
+block(Addr,Port,non_disturbing,Timeout) when 
+  is_integer(Port), is_integer(Timeout) ->
+    do_block(Addr,Port,non_disturbing,Timeout);
+block(Addr,Port,disturbing,Timeout) when is_integer(Port), 
+					 is_integer(Timeout) ->
+    do_block(Addr,Port,disturbing,Timeout).
+
+do_block(Addr,Port,Mode) when is_integer(Port), is_atom(Mode) -> 
+    Name = make_name(Addr,Port),
+    case whereis(Name) of
+	Pid when pid(Pid) ->
+	    httpd_manager:block(Pid,Mode);
+	_ ->
+	    {error,not_started}
+    end.
+    
+
+do_block(Addr,Port,Mode,Timeout) when is_integer(Port), is_atom(Mode) -> 
+    Name = make_name(Addr,Port),
+    case whereis(Name) of
+	Pid when pid(Pid) ->
+	    httpd_manager:block(Pid,Mode,Timeout);
+	_ ->
+	    {error,not_started}
+    end.
+    
+
+%%% =========================================================
+%%% Function:    unblock/0, unblock/1, unblock/2
+%%%              unblock()
+%%%              unblock(Port)
+%%%              unblock(ConfigFile)
+%%%              unblock(Addr,Port)
+%%%              
+%%% Description: This function is used to reverse a previous block 
+%%%              operation on the HTTP server.
+%%%
+%%% Types:       Port       -> integer()             
+%%%              Addr       -> {A,B,C,D} | string() | undefined
+%%%              ConfigFile -> string()
+%%%
+unblock()                        -> unblock(undefined,5984).
+unblock(Port) when is_integer(Port) -> unblock(undefined,Port);
+
+unblock(ConfigFile) when is_list(ConfigFile) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok,Addr,Port} ->
+	    unblock(Addr,Port);
+	Error ->
+	    Error
+    end.
+
+unblock(Addr,Port) when is_integer(Port) -> 
+    Name = make_name(Addr,Port),
+    case whereis(Name) of
+	Pid when pid(Pid) ->
+	    httpd_manager:unblock(Pid);
+	_ ->
+	    {error,not_started}
+    end.
+
+%%% =========================================================
+%%% Function:    get_admin_state/0, get_admin_state/1, get_admin_state/2
+%%%              get_admin_state()
+%%%              get_admin_state(Port)
+%%%              get_admin_state(Addr,Port)
+%%%              
+%%% Returns:     {ok,State} | {error,Reason}
+%%%              
+%%% Description: This function is used to retrieve the administrative 
+%%%              state of the HTTP server.
+%%%
+%%% Types:       Port    -> integer()             
+%%%              Addr    -> {A,B,C,D} | string() | undefined
+%%%              State   -> unblocked | shutting_down | blocked
+%%%              Reason  -> term()
+%%%
+get_admin_state()                        -> get_admin_state(undefined,5984).
+get_admin_state(Port) when is_integer(Port) -> get_admin_state(undefined,Port);
+
+get_admin_state(ConfigFile) when is_list(ConfigFile) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok,Addr,Port} ->
+	    unblock(Addr,Port);
+	Error ->
+	    Error
+    end.
+
+get_admin_state(Addr,Port) when is_integer(Port) -> 
+    Name = make_name(Addr,Port),
+    case whereis(Name) of
+	Pid when is_pid(Pid) ->
+	    httpd_manager:get_admin_state(Pid);
+	_ ->
+	    {error,not_started}
+    end.
+
+
+
+%%% =========================================================
+%%% Function:    get_usage_state/0, get_usage_state/1, get_usage_state/2
+%%%              get_usage_state()
+%%%              get_usage_state(Port)
+%%%              get_usage_state(Addr,Port)
+%%%              
+%%% Returns:     {ok,State} | {error,Reason}
+%%%              
+%%% Description: This function is used to retrieve the usage 
+%%%              state of the HTTP server.
+%%%
+%%% Types:       Port    -> integer()             
+%%%              Addr    -> {A,B,C,D} | string() | undefined
+%%%              State   -> idle | active | busy
+%%%              Reason  -> term()
+%%%
+get_usage_state()                        -> get_usage_state(undefined,5984).
+get_usage_state(Port) when is_integer(Port) -> get_usage_state(undefined,Port);
+
+get_usage_state(ConfigFile) when is_list(ConfigFile) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok,Addr,Port} ->
+	    unblock(Addr,Port);
+	Error ->
+	    Error
+    end.
+
+get_usage_state(Addr,Port) when is_integer(Port) -> 
+    Name = make_name(Addr,Port),
+    case whereis(Name) of
+	Pid when is_pid(Pid) ->
+	    httpd_manager:get_usage_state(Pid);
+	_ ->
+	    {error,not_started}
+    end.
+
+
+
+%%% =========================================================
+%% Function:    get_status(ConfigFile)        -> Status
+%%              get_status(Port)              -> Status
+%%              get_status(Addr,Port)         -> Status
+%%              get_status(Port,Timeout)      -> Status
+%%              get_status(Addr,Port,Timeout) -> Status
+%%
+%% Arguments:   ConfigFile -> string()  
+%%                            Configuration file from which Port and 
+%%                            BindAddress will be extracted.
+%%              Addr       -> {A,B,C,D} | string()
+%%                            Bind Address of the http server
+%%              Port       -> integer()
+%%                            Port number of the http server
+%%              Timeout    -> integer()
+%%                            Timeout time for the call
+%%
+%% Returns:     Status -> list()
+%%
+%% Description: This function is used when the caller runs in the 
+%%              same node as the http server or if calling with a 
+%%              program such as erl_call (see erl_interface).
+%% 
+
+get_status(ConfigFile) when is_list(ConfigFile) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok,Addr,Port} ->
+	    get_status(Addr,Port);
+	Error ->
+	    Error
+    end;
+
+get_status(Port) when is_integer(Port) ->
+    get_status(undefined,Port,5000).
+
+get_status(Port,Timeout) when is_integer(Port), is_integer(Timeout) ->
+    get_status(undefined,Port,Timeout);
+
+get_status(Addr,Port) when is_list(Addr), is_integer(Port) ->
+    get_status(Addr,Port,5000).
+
+get_status(Addr,Port,Timeout) when is_integer(Port) ->
+    Name = make_name(Addr,Port), 
+    case whereis(Name) of
+	Pid when is_pid(Pid) ->
+	    httpd_manager:get_status(Pid,Timeout);
+	_ ->
+	    not_started
+    end.
+
+load(ConfigFile) ->
+    httpd_conf:load(ConfigFile).
+
+load_mime_types(MimeTypesFile) ->
+    httpd_conf:load_mime_types(MimeTypesFile).
+
+parse_query(String) ->
+  {ok, SplitString} = regexp:split(String,"[&;]"),
+  foreach(SplitString).
+
+foreach([]) ->
+  [];
+foreach([KeyValue|Rest]) ->
+  {ok, Plus2Space, _} = regexp:gsub(KeyValue,"[\+]"," "),
+  case regexp:split(Plus2Space,"=") of
+    {ok,[Key|Value]} ->
+      [{httpd_util:decode_hex(Key),
+	httpd_util:decode_hex(lists:flatten(Value))}|foreach(Rest)];
+    {ok,_} ->
+      foreach(Rest)
+  end.
+
+get_addr_and_port(ConfigFile) ->
+    case httpd_conf:load(ConfigFile) of
+	{ok,ConfigList} ->
+	    Port = httpd_util:key1search(ConfigList,port,80),
+	    Addr = httpd_util:key1search(ConfigList,bind_address),
+	    {ok,Addr,Port};
+	Error ->
+	    Error
+    end.
+
+
+make_name(Addr,Port) ->
+    httpd_util:make_name("httpd",Addr,Port).
+
+
+%% Multi stuff
+%%
+
+read_multi_file(File) ->
+    read_mfile(file:open(File,read)).
+
+read_mfile({ok,Fd}) ->
+    read_mfile(read_line(Fd),Fd,[]);
+read_mfile(Error) ->
+    Error.
+
+read_mfile(eof, _Fd, SoFar) ->
+    {ok,lists:reverse(SoFar)};
+read_mfile([$# | _Comment], Fd, SoFar) ->
+    read_mfile(read_line(Fd), Fd, SoFar);
+read_mfile([], Fd, SoFar) ->
+    read_mfile(read_line(Fd), Fd, SoFar);
+read_mfile(Line, Fd, SoFar) ->
+    read_mfile(read_line(Fd), Fd, [Line | SoFar]).
+
+read_line(Fd)      -> read_line1(io:get_line(Fd, [])).
+read_line1(eof)    -> eof;
+read_line1(String) -> httpd_conf:clean(String).
+
+

Added: incubator/couchdb/trunk/src/couch_inets/httpd.hrl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd.hrl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd.hrl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd.hrl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,78 @@
+%% ``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_lib("kernel/include/file.hrl").
+
+-ifndef(SERVER_SOFTWARE).
+-define(SERVER_SOFTWARE,"inets/develop").	% Define in Makefile!
+-endif.
+-define(SERVER_PROTOCOL,"HTTP/1.1").
+-define(SOCKET_CHUNK_SIZE,8192).
+-define(SOCKET_MAX_POLL,25).
+-define(FILE_CHUNK_SIZE,64*1024).
+-define(GATEWAY_INTERFACE,"CGI/1.1").
+-define(NICE(Reason),lists:flatten(atom_to_list(?MODULE)++": "++Reason)).
+-define(DEFAULT_CONTEXT,
+	[{errmsg,"[an error occurred while processing this directive]"},
+	 {timefmt,"%A, %d-%b-%y %T %Z"},
+	 {sizefmt,"abbrev"}]).
+
+
+-ifdef(inets_error).
+-define(ERROR(Format, Args), io:format("E(~p:~p:~p) : "++Format++"~n",
+				       [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(ERROR(F,A),[]).
+-endif.
+
+-ifdef(inets_log).
+-define(LOG(Format, Args), io:format("L(~p:~p:~p) : "++Format++"~n",
+				     [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(LOG(F,A),[]).
+-endif.
+
+-ifdef(inets_debug).
+-define(DEBUG(Format, Args), io:format("D(~p:~p:~p) : "++Format++"~n",
+				       [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(DEBUG(F,A),[]).
+-endif.
+
+-ifdef(inets_cdebug).
+-define(CDEBUG(Format, Args), io:format("C(~p:~p:~p) : "++Format++"~n",
+				       [self(),?MODULE,?LINE]++Args)).
+-else.
+-define(CDEBUG(F,A),[]).
+-endif.
+
+
+-record(init_data,{peername,resolve}).
+-record(mod,{init_data,
+	     data=[],
+	     socket_type=ip_comm,
+	     socket,
+	     config_db,
+	     method,
+	     absolute_uri=[],
+	     request_uri,
+	     http_version,
+	     request_line,
+	     parsed_header=[],
+	     entity_body,
+	     connection}).

Added: incubator/couchdb/trunk/src/couch_inets/httpd_acceptor.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd_acceptor.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd_acceptor.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd_acceptor.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,155 @@
+%% ``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(httpd_acceptor).
+
+-include("httpd.hrl").
+
+%% External API
+-export([start_link/5, start_link/6]).
+
+%% Other exports (for spawn's etc.)
+-export([acceptor/5, acceptor/6, acceptor/7]).
+
+
+%%
+%% External API
+%%
+
+%% start_link
+
+start_link(Manager, SocketType, Addr, Port, ConfigDb) ->
+    start_link(Manager, SocketType, Addr, Port, ConfigDb, 15000).
+
+start_link(Manager, SocketType, Addr, Port, ConfigDb,AcceptTimeout) ->
+    Args = [self(), Manager, SocketType, Addr, Port, ConfigDb, AcceptTimeout],
+    proc_lib:start_link(?MODULE, acceptor, Args).
+
+acceptor(Parent, Manager, SocketType, Addr, Port, ConfigDb) ->
+    acceptor(Parent, Manager, SocketType, Addr, Port, ConfigDb, 15000).
+acceptor(Parent, Manager, SocketType, Addr, Port, ConfigDb, AcceptTimeout) ->
+    case (catch do_init(SocketType, Addr, Port)) of
+	{ok, ListenSocket} ->
+	    proc_lib:init_ack(Parent, {ok, self()}),
+	    acceptor(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout);
+	Error ->
+	    proc_lib:init_ack(Parent, Error),
+	    error
+    end.
+   
+do_init(SocketType, Addr, Port) ->
+    do_socket_start(SocketType),
+    ListenSocket = do_socket_listen(SocketType, Addr, Port),
+    {ok, ListenSocket}.
+
+
+do_socket_start(SocketType) ->
+    case http_transport:start(SocketType) of
+	ok ->
+	    ok;
+	{error, Reason} ->
+	    throw({error, {socket_start_failed, Reason}})
+    end.
+
+
+do_socket_listen(SocketType, Addr, Port) ->
+    case http_transport:listen(SocketType, Addr, Port) of
+	{ok, ListenSocket} ->
+	    ListenSocket;
+	{error, Reason} ->
+	    throw({error, {listen, Reason}})
+    end.
+
+
+%% acceptor 
+
+acceptor(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) ->
+    case (catch http_transport:accept(SocketType, ListenSocket, 50000)) of
+	{ok, Socket} ->
+	    handle_connection(Manager, ConfigDb, AcceptTimeout, SocketType, Socket),
+	    ?MODULE:acceptor(Manager, SocketType, ListenSocket, ConfigDb,AcceptTimeout);
+	{error, Reason} ->
+	    handle_error(Reason, ConfigDb, SocketType),
+	    ?MODULE:acceptor(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout);
+	{'EXIT', Reason} ->
+	    handle_error({'EXIT', Reason}, ConfigDb, SocketType),
+	    ?MODULE:acceptor(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout)
+    end.
+
+
+handle_connection(Manager, ConfigDb, AcceptTimeout, SocketType, Socket) ->
+    {ok, Pid} = httpd_request_handler:start(Manager, ConfigDb, AcceptTimeout),
+    http_transport:controlling_process(SocketType, Socket, Pid),
+    httpd_request_handler:socket_ownership_transfered(Pid, SocketType, Socket).
+
+handle_error(timeout, _, _) ->
+    ok;
+
+handle_error({enfile, _}, _, _) ->
+    %% Out of sockets...
+    sleep(200);
+
+handle_error(emfile, _, _) ->
+    %% Too many open files -> Out of sockets...
+    sleep(200);
+
+handle_error(closed, _, _) ->
+    error_logger:info_report("The httpd accept socket was closed by" 
+			     "a third party. "
+			     "This will not have an impact on inets "
+			     "that will open a new accept socket and " 
+			     "go on as nothing happened. It does however "
+			     "indicate that some other software is behaving "
+			     "badly."),
+    exit(normal);
+
+%% This will only happen when the client is terminated abnormaly
+%% and is not a problem for the server, so we want
+%% to terminate normal so that we can restart without any 
+%% error messages.
+handle_error(econnreset,_,_) ->
+    exit(normal);
+
+handle_error(econnaborted, _, _) ->
+    ok;
+
+handle_error(esslaccept, _, _) ->
+    %% The user has selected to cancel the installation of 
+    %% the certifikate, This is not a real error, so we do 
+    %% not write an error message.
+    ok;
+
+handle_error({'EXIT', Reason}, ConfigDb, SocketType) ->
+    String = lists:flatten(io_lib:format("Accept exit: ~p", [Reason])),
+    accept_failed(SocketType, ConfigDb, String);
+
+handle_error(Reason, ConfigDb, SocketType) ->
+    String = lists:flatten(io_lib:format("Accept error: ~p", [Reason])),
+    accept_failed(SocketType, ConfigDb, String).
+
+
+accept_failed(SocketType, ConfigDb, String) ->
+    error_logger:error_report(String),
+    mod_log:error_log(SocketType, undefined, ConfigDb, 
+		      {0, "unknown"}, String),
+    mod_disk_log:error_log(SocketType, undefined, ConfigDb, 
+			   {0, "unknown"}, String),
+    exit({accept_failed, String}).    
+
+sleep(T) -> receive after T -> ok end.
+
+

Added: incubator/couchdb/trunk/src/couch_inets/httpd_acceptor_sup.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd_acceptor_sup.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd_acceptor_sup.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd_acceptor_sup.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,84 @@
+%% ``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$
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The supervisor for acceptor processes in the http server, 
+%%          hangs under the httpd_instance_sup_<Addr>_<Port> supervisor.
+%%----------------------------------------------------------------------
+
+-module(httpd_acceptor_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/2, start_acceptor/4, start_acceptor/5, stop_acceptor/2]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%%  API
+%%%=========================================================================
+start_link(Addr, Port) ->
+    SupName = make_name(Addr, Port),
+    supervisor:start_link({local, SupName}, ?MODULE, []).
+
+%%----------------------------------------------------------------------
+%% Function: [start|stop]_acceptor/5
+%% Description: Starts/stops an [auth | security] worker (child) process
+%%----------------------------------------------------------------------
+start_acceptor(SocketType, Addr, Port, ConfigDb) ->
+    start_acceptor(SocketType, Addr, Port, ConfigDb,15000).
+start_acceptor(SocketType, Addr, Port, ConfigDb, AcceptTimeout) ->
+    start_worker(httpd_acceptor, SocketType, Addr, Port,
+		 ConfigDb, AcceptTimeout, self(), []).
+
+stop_acceptor(Addr, Port) ->
+    stop_worker(httpd_acceptor, Addr, Port).
+
+%%%=========================================================================
+%%%  Supervisor callback
+%%%=========================================================================
+init(_) ->    
+    Flags     = {one_for_one, 500, 100},
+    Workers   = [],
+    {ok, {Flags, Workers}}.
+
+%%%=========================================================================
+%%%  Internal functions
+%%%=========================================================================  
+
+make_name(Addr,Port) ->
+    httpd_util:make_name("httpd_acc_sup", Addr, Port).
+
+start_worker(M, SocketType, Addr, Port, ConfigDB, AcceptTimeout, Manager, Modules) ->
+    SupName = make_name(Addr, Port),
+    Args    = [Manager, SocketType, Addr, Port, ConfigDB, AcceptTimeout],
+    Spec    = {{M, Addr, Port},
+	       {M, start_link, Args}, 
+	       permanent, timer:seconds(1), worker, [M] ++ Modules},
+    supervisor:start_child(SupName, Spec).
+
+stop_worker(M, Addr, Port) ->
+    SupName = make_name(Addr, Port),
+    Name    = {M, Addr, Port},
+    case supervisor:terminate_child(SupName, Name) of
+	ok ->
+	    supervisor:delete_child(SupName, Name);
+	Error ->
+	    Error
+    end.

Added: incubator/couchdb/trunk/src/couch_inets/httpd_cgi.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd_cgi.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd_cgi.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd_cgi.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,122 @@
+%% ``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(httpd_cgi).
+
+-export([parse_headers/1, handle_headers/1]).
+
+-include("inets_internal.hrl").
+
+%%%=========================================================================
+%%%  Internal application API 
+%%%=========================================================================
+
+%%--------------------------------------------------------------------------
+%% parse_headers([Bin, Data, Header, Headers]) -> {RevHeaders, Body} | 
+%%                                                {Module, Function, Args}
+%% Bin = Data = binary()
+%% Header = string() - Accumulator should be [] in first call
+%% Headers = [Header] - Accumulator should be [] in first call
+%% Body = string()
+%% RevHeaders = string() - Note CGI-headers not HTTP-headers 
+%%
+%% Description: Parses "<<Bin/binary, Data/binary>>" returned from the
+%% CGI-script until it findes the end of the CGI-headers (at least one
+%% CGI-HeaderField must be supplied) then it returns the CGI-headers
+%% and maybe some body data. If {Module, Function, Args} is
+%% returned it means that more data needs to be collected from the
+%% cgi-script as the end of the headers was not yet found. When more
+%% data has been collected call Module:Function([NewData | Args]).
+%%
+%% NOTE: The headers are backwards and should
+%% be so, devide_and_reverse_headers will reverse them back after
+%% taking advantage of the fact that they where backwards.  
+%%--------------------------------------------------------------------------
+parse_headers([Data, Bin,  Header, Headers]) ->
+    parse_headers(<<Bin/binary, Data/binary>>, Header, Headers).
+
+%%--------------------------------------------------------------------------
+%% handle_headers(CGIHeaders) -> {ok, HTTPHeaders, StatusCode} |
+%%                            {proceed, AbsPath}  
+%%	CGIHeaders = [string()]   
+%%	HTTPHeaders = [{HeaderField, HeaderValue}]
+%%      HeaderField = string()
+%%      HeaderValue = string()
+%%      StatusCode = integer()
+%% 
+%% Description: Interprets CGI headers and creates HTTP headers and a  
+%% appropriate HTTP status code. Note if a CGI location header is present
+%% the return value will be {proceed, AbsPath}
+%%--------------------------------------------------------------------------
+handle_headers(CGIHeaders) ->
+    handle_headers(CGIHeaders, [], {200, "ok"}).
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+parse_headers(<<>>, Header, Headers) ->
+    {?MODULE, parse_headers, [<<>>, Header, Headers]};
+parse_headers(<<?CR,?LF>>, Header, Headers) ->
+    {?MODULE, parse_headers, [<<?CR,?LF>>, Header, Headers]};
+parse_headers(<<?LF>>, Header, Headers) ->
+    {?MODULE, parse_headers, [<<?LF>>, Header, Headers]};
+parse_headers(<<?CR, ?LF, ?CR, ?LF, Rest/binary>>, Header, Headers) ->
+    {ok, {[lists:reverse([?LF, ?CR | Header]) | Headers], Rest}};
+parse_headers(<<?LF, ?LF, Rest/binary>>, Header, Headers) ->
+    {ok, {[lists:reverse([?LF | Header]) | Headers], Rest}};
+parse_headers(<<?CR, ?LF, Rest/binary>>, Header, Headers) ->
+    parse_headers(Rest, [], [lists:reverse([?LF, ?CR | Header]) | Headers]);
+parse_headers(<<?LF, Rest/binary>>, Header, Headers) ->
+    parse_headers(Rest, [], [lists:reverse([?LF | Header]) | Headers]);
+parse_headers(<<Octet, Rest/binary>>, Header, Headers) ->
+    parse_headers(Rest, [Octet | Header], Headers).
+
+handle_headers([], HTTPHeaders, Status) ->
+    {ok, HTTPHeaders, Status};
+
+handle_headers([CGIHeader | CGIHeaders], HTTPHeaders, Status) ->
+    
+    {FieldName, FieldValue} = httpd_response:split_header(CGIHeader, []),
+   
+    case FieldName of
+	"content-type" ->
+	    handle_headers(CGIHeaders,
+			   [{FieldName, FieldValue} | HTTPHeaders], 
+			   Status);
+	"location" ->
+	    case http_request:is_absolut_uri(FieldValue) of
+		true ->
+		    handle_headers(CGIHeaders, 
+				       [{FieldName, FieldValue} | 
+					HTTPHeaders], {302, "Redirect"});
+		false ->
+		    {proceed, FieldValue}
+	    end;
+	"status" ->
+	    CodePhrase = 
+		case httpd_util:split(FieldValue," ",2) of
+		    {ok,[Code, Phrase]} ->
+			{list_to_integer(Code), Phrase};
+		    _ ->
+			{200, "OK"}
+		end,
+	    handle_headers(CGIHeaders, HTTPHeaders, CodePhrase);
+	_ -> %% Extension headers
+	    handle_headers(CGIHeaders,
+			   [{FieldName, FieldValue} | HTTPHeaders], Status)
+    end.	
+

Added: incubator/couchdb/trunk/src/couch_inets/httpd_conf.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd_conf.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd_conf.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd_conf.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,720 @@
+%% ``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(httpd_conf).
+
+%% EWSAPI 
+-export([is_directory/1, is_file/1, make_integer/1, clean/1, 
+	 custom_clean/3, check_enum/2]).
+
+%% Application internal API
+-export([load/1, load/2, load_mime_types/1, store/1, store/2,
+	remove/1, remove_all/1, config/1]).
+
+-define(VMODULE,"CONF").
+-include("httpd.hrl").
+
+%%%=========================================================================
+%%%  EWSAPI
+%%%=========================================================================
+%%-------------------------------------------------------------------------
+%%  is_directory(FilePath) -> Result
+%%	FilePath = string()
+%%      Result = {ok,Directory} | {error,Reason}
+%%      Directory = string()
+%%      Reason = string() | enoent | eaccess | enotdir | FileInfo
+%%      FileInfo = File info record
+%%
+%% Description: Checks if FilePath is a directory in which case it is
+%% returned. 
+%%-------------------------------------------------------------------------
+is_directory(Directory) ->
+    case file:read_file_info(Directory) of
+	{ok,FileInfo} ->
+	    #file_info{type = Type, access = Access} = FileInfo,
+	    is_directory(Type,Access,FileInfo,Directory);
+	{error,Reason} ->
+	    {error,Reason}
+    end.
+is_directory(directory,read,_FileInfo,Directory) ->
+    {ok,Directory};
+is_directory(directory,read_write,_FileInfo,Directory) ->
+    {ok,Directory};
+is_directory(_Type,_Access,FileInfo,_Directory) ->
+    {error,FileInfo}.
+%%-------------------------------------------------------------------------
+%% is_file(FilePath) -> Result
+%%	FilePath = string()
+%%      Result = {ok,File} | {error,Reason}
+%%      File = string()
+%%      Reason = string() | enoent | eaccess | enotdir | FileInfo
+%%      FileInfo = File info record
+%%
+%% Description: Checks if FilePath is a regular file in which case it
+%% is returned.
+%%-------------------------------------------------------------------------
+is_file(File) ->
+    case file:read_file_info(File) of
+	{ok,FileInfo} ->
+	    #file_info{type = Type, access = Access} = FileInfo,
+	    is_file(Type,Access,FileInfo,File);
+	{error,Reason} ->
+	    {error,Reason}
+    end.
+is_file(regular,read,_FileInfo,File) ->
+    {ok,File};
+is_file(regular,read_write,_FileInfo,File) ->
+    {ok,File};
+is_file(_Type,_Access,FileInfo,_File) ->
+    {error,FileInfo}.
+%%-------------------------------------------------------------------------
+%% make_integer(String) -> Result
+%% String = string()
+%% Result = {ok,integer()} | {error,nomatch}
+%%
+%% Description: make_integer/1 returns an integer representation of String. 
+%%-------------------------------------------------------------------------
+make_integer(String) ->
+    case regexp:match(clean(String),"[0-9]+") of
+	{match, _, _} ->
+	    {ok, list_to_integer(clean(String))};
+	nomatch ->
+	    {error, nomatch}
+    end.
+%%-------------------------------------------------------------------------
+%% clean(String) -> Stripped
+%% String = Stripped = string()
+%%
+%% Description:clean/1 removes leading and/or trailing white spaces
+%% from String.
+%%-------------------------------------------------------------------------
+clean(String) ->
+    {ok,CleanedString,_} = 
+	regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""),
+    CleanedString.
+%%-------------------------------------------------------------------------
+%% custom_clean(String,Before,After) -> Stripped
+%% Before = After = regexp()
+%% String = Stripped = string()
+%%
+%% Description: custom_clean/3 removes leading and/or trailing white
+%% spaces and custom characters from String. 
+%%-------------------------------------------------------------------------
+custom_clean(String,MoreBefore,MoreAfter) ->
+    {ok,CleanedString,_} = regexp:gsub(String,"^[ \t\n\r\f"++MoreBefore++
+				       "]*|[ \t\n\r\f"++MoreAfter++"]*\$",""),
+    CleanedString.
+%%-------------------------------------------------------------------------
+%% check_enum(EnumString,ValidEnumStrings) -> Result
+%%	EnumString = string()
+%%      ValidEnumStrings = [string()]
+%%      Result = {ok,atom()} | {error,not_valid}
+%%
+%% Description: check_enum/2 checks if EnumString is a valid
+%% enumeration of ValidEnumStrings in which case it is returned as an
+%% atom.
+%%-------------------------------------------------------------------------
+check_enum(_Enum,[]) ->
+    {error, not_valid};
+check_enum(Enum,[Enum|_Rest]) ->
+    {ok, list_to_atom(Enum)};
+check_enum(Enum, [_NotValid|Rest]) ->
+    check_enum(Enum, Rest).
+
+%%%=========================================================================
+%%%  Application internal API
+%%%=========================================================================
+%% The configuration data is handled in three (3) phases:
+%% 1. Parse the config file and put all directives into a key-vale
+%%    tuple list (load/1). 
+%% 2. Traverse the key-value tuple list store it into an ETS table.
+%%    Directives depending on other directives are taken care of here
+%%    (store/1).
+%% 3. Traverse the ETS table and do a complete clean-up (remove/1).
+
+%% Phase 1: Load
+load(ConfigFile) ->
+    case read_config_file(ConfigFile) of
+	{ok, Config} ->
+	    case bootstrap(Config) of
+		{error, Reason} ->
+		    {error, Reason};
+		{ok, Modules} ->
+		    load_config(Config, lists:append(Modules, [?MODULE]))
+	    end;
+	{error, Reason} ->
+	    {error, ?NICE("Error while reading config file: "++Reason)}
+    end.
+
+load(eof, []) ->
+    eof;
+load("MaxHeaderSize " ++ MaxHeaderSize, []) ->
+    case make_integer(MaxHeaderSize) of
+        {ok, Integer} ->
+            {ok, [], {max_header_size,Integer}};
+        {error, _} ->
+            {error, ?NICE(clean(MaxHeaderSize)++
+                          " is an invalid number of MaxHeaderSize")}
+    end;
+load("MaxHeaderAction " ++ Action, []) ->
+    {ok, [], {max_header_action,list_to_atom(clean(Action))}};
+load("MaxBodySize " ++ MaxBodySize, []) ->
+    case make_integer(MaxBodySize) of
+        {ok, Integer} ->
+            {ok, [], {max_body_size,Integer}};
+        {error, _} ->
+            {error, ?NICE(clean(MaxBodySize)++
+                          " is an invalid number of MaxBodySize")}
+    end;
+load("MaxBodyAction " ++ Action, []) ->
+    {ok, [], {max_body_action,list_to_atom(clean(Action))}};
+load("ServerName " ++ ServerName, []) ->
+    {ok,[],{server_name,clean(ServerName)}};
+load("SocketType " ++ SocketType, []) ->
+    case check_enum(clean(SocketType),["ssl","ip_comm"]) of
+	{ok, ValidSocketType} ->
+	    {ok, [], {com_type,ValidSocketType}};
+	{error,_} ->
+	    {error, ?NICE(clean(SocketType) ++ " is an invalid SocketType")}
+    end;
+load("Port " ++ Port, []) ->
+    case make_integer(Port) of
+	{ok, Integer} ->
+	    {ok, [], {port,Integer}};
+	{error, _} ->
+	    {error, ?NICE(clean(Port)++" is an invalid Port")}
+    end;
+load("BindAddress " ++ Address, []) ->
+    %% If an ipv6 address is provided in URL-syntax strip the
+    %% url specific part e.i. "[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]"
+    %% -> "FEDC:BA98:7654:3210:FEDC:BA98:7654:3210"
+    NewAddress = string:strip(string:strip(clean(Address), 
+					   left, $[), 
+			      right, $]),
+    case NewAddress of
+	"*" ->
+	    {ok, [], {bind_address,any}};
+	CAddress ->
+	    case (catch inet:getaddr(CAddress,inet6)) of
+		{ok, {0, 0, 0, 0, 0, 16#ffff, _, _}} ->
+		    case inet:getaddr(CAddress, inet) of
+			{ok, IPAddr} ->
+			    {ok, [], {bind_address,IPAddr}};
+			{error, _} ->
+			    {error, ?NICE(CAddress++" is an invalid address")}
+		    end;
+		{ok, IPAddr} ->
+		    {ok, [], {bind_address, IPAddr}};
+		_ ->
+		    case inet:getaddr(CAddress, inet) of
+			{ok, IPAddr} ->
+			    {ok, [], {bind_address,IPAddr}};
+			{error, _} ->
+			    {error, ?NICE(CAddress++" is an invalid address")}
+		    end
+	    end
+    end;
+load("KeepAlive " ++ OnorOff, []) ->
+    case list_to_atom(clean(OnorOff)) of
+	off ->
+	    {ok, [], {persistent_conn, false}};
+	_ ->
+	    {ok, [], {persistent_conn, true}}
+    end;
+load("MaxKeepAliveRequests " ++  MaxRequests, []) ->
+    case make_integer(MaxRequests) of
+	{ok, Integer} ->
+	    {ok, [], {max_keep_alive_request, Integer}};
+	{error, _} ->
+	    {error, ?NICE(clean(MaxRequests) ++
+			  " is an invalid MaxKeepAliveRequests")}
+    end;
+%% This clause is keept for backwards compability 
+load("MaxKeepAliveRequest " ++  MaxRequests, []) ->
+    case make_integer(MaxRequests) of
+	{ok, Integer} ->
+	    {ok, [], {max_keep_alive_request, Integer}};
+	{error, _} ->
+	    {error, ?NICE(clean(MaxRequests) ++
+			  " is an invalid MaxKeepAliveRequest")}
+    end;
+load("KeepAliveTimeout " ++ Timeout, []) ->
+    case make_integer(Timeout) of
+	{ok, Integer} ->
+	    {ok, [], {keep_alive_timeout, Integer*1000}};
+	{error, _} ->
+	    {error, ?NICE(clean(Timeout)++" is an invalid KeepAliveTimeout")}
+    end;
+load("Modules " ++ Modules, []) ->
+    {ok, ModuleList} = regexp:split(Modules," "),
+    {ok, [], {modules,[list_to_atom(X) || X <- ModuleList]}};
+load("ServerAdmin " ++ ServerAdmin, []) ->
+    {ok, [], {server_admin,clean(ServerAdmin)}};
+load("ServerRoot " ++ ServerRoot, []) ->
+    case is_directory(clean(ServerRoot)) of
+	{ok, Directory} ->
+	    MimeTypesFile = 
+		filename:join([clean(ServerRoot),"conf", "mime.types"]),
+	    case load_mime_types(MimeTypesFile) of
+		{ok, MimeTypesList} ->
+		    {ok, [], [{server_root,string:strip(Directory,right,$/)},
+			      {mime_types,MimeTypesList}]};
+		{error, Reason} ->
+		    {error, Reason}
+	    end;
+	{error, _} ->
+	    {error, ?NICE(clean(ServerRoot)++" is an invalid ServerRoot")}
+    end;
+load("MaxClients " ++ MaxClients, []) ->
+    case make_integer(MaxClients) of
+	{ok, Integer} ->
+	    {ok, [], {max_clients,Integer}};
+	{error, _} ->
+	    {error, ?NICE(clean(MaxClients) ++
+			  " is an invalid number of MaxClients")}
+    end;
+load("DocumentRoot " ++ DocumentRoot,[]) ->
+    case is_directory(clean(DocumentRoot)) of
+	{ok, Directory} ->
+	    {ok, [], {document_root,string:strip(Directory,right,$/)}};
+	{error, _} ->
+	    {error, ?NICE(clean(DocumentRoot)++"is an invalid DocumentRoot")}
+    end;
+load("DefaultType " ++ DefaultType, []) ->
+    {ok, [], {default_type,clean(DefaultType)}};
+load("SSLCertificateFile " ++ SSLCertificateFile, []) ->
+    case is_file(clean(SSLCertificateFile)) of
+	{ok, File} ->
+	    {ok, [], {ssl_certificate_file,File}};
+    {error, _} ->
+	    {error, ?NICE(clean(SSLCertificateFile)++
+			  " is an invalid SSLCertificateFile")}
+    end;
+load("SSLCertificateKeyFile " ++ SSLCertificateKeyFile, []) ->
+    case is_file(clean(SSLCertificateKeyFile)) of
+	{ok, File} ->
+	    {ok, [], {ssl_certificate_key_file,File}};
+	{error, _} ->
+	    {error, ?NICE(clean(SSLCertificateKeyFile)++
+			  " is an invalid SSLCertificateKeyFile")}
+    end;
+load("SSLVerifyClient " ++ SSLVerifyClient, []) ->
+    case make_integer(clean(SSLVerifyClient)) of
+	{ok, Integer} when Integer >=0,Integer =< 2 ->
+	    {ok, [], {ssl_verify_client,Integer}};
+	{ok, _Integer} ->
+	    {error,?NICE(clean(SSLVerifyClient) ++
+			 " is an invalid SSLVerifyClient")};
+	{error, nomatch} ->
+	    {error,?NICE(clean(SSLVerifyClient) ++ 
+			 " is an invalid SSLVerifyClient")}
+    end;
+load("SSLVerifyDepth " ++ SSLVerifyDepth, []) ->
+    case make_integer(clean(SSLVerifyDepth)) of
+	{ok, Integer} when Integer > 0 ->
+	    {ok, [], {ssl_verify_client_depth,Integer}};
+	{ok, _Integer} ->
+	    {error,?NICE(clean(SSLVerifyDepth) ++
+			 " is an invalid SSLVerifyDepth")};
+	{error, nomatch} ->
+	    {error,?NICE(clean(SSLVerifyDepth) ++
+			 " is an invalid SSLVerifyDepth")}
+    end;
+load("SSLCiphers " ++ SSLCiphers, []) ->
+    {ok, [], {ssl_ciphers, clean(SSLCiphers)}};
+load("SSLCACertificateFile " ++ SSLCACertificateFile, []) ->
+    case is_file(clean(SSLCACertificateFile)) of
+	{ok, File} ->
+	    {ok, [], {ssl_ca_certificate_file,File}};
+	{error, _} ->
+	    {error, ?NICE(clean(SSLCACertificateFile)++
+			  " is an invalid SSLCACertificateFile")}
+    end;
+load("SSLPasswordCallbackModule " ++ SSLPasswordCallbackModule, []) ->
+    {ok, [], {ssl_password_callback_module,
+	      list_to_atom(clean(SSLPasswordCallbackModule))}};
+load("SSLPasswordCallbackFunction " ++ SSLPasswordCallbackFunction, []) ->
+    {ok, [], {ssl_password_callback_function,
+	      list_to_atom(clean(SSLPasswordCallbackFunction))}};
+load("DisableChunkedTransferEncodingSend " ++ TrueOrFalse, []) ->
+    case list_to_atom(clean(TrueOrFalse)) of
+	true ->
+	    {ok, [], {disable_chunked_transfer_encoding_send, true}};
+	_ ->
+	    {ok, [], {disable_chunked_transfer_encoding_send, false}}
+    end.
+
+%%
+%% load_mime_types/1 -> {ok, MimeTypes} | {error, Reason}
+%%
+load_mime_types(MimeTypesFile) ->
+    case file:open(MimeTypesFile, read) of
+	{ok, Stream} ->
+	    parse_mime_types(Stream, []);
+	{error, _} ->
+	    {error, ?NICE("Can't open " ++ MimeTypesFile)}
+    end.
+
+%% Phase 2: Store
+store(ConfigList) ->
+    Modules = httpd_util:key1search(ConfigList, modules, []),
+    Port = httpd_util:key1search(ConfigList, port),
+    Addr = httpd_util:key1search(ConfigList,bind_address),
+    Name = httpd_util:make_name("httpd_conf",Addr,Port),
+    ConfigDB = ets:new(Name, [named_table, bag, protected]),
+    store(ConfigDB, ConfigList, lists:append(Modules,[?MODULE]),ConfigList).
+
+store({mime_types,MimeTypesList},ConfigList) ->
+    Port = httpd_util:key1search(ConfigList, port),
+    Addr = httpd_util:key1search(ConfigList, bind_address),
+    Name = httpd_util:make_name("httpd_mime",Addr,Port),
+    {ok, MimeTypesDB} = store_mime_types(Name,MimeTypesList),
+    {ok, {mime_types,MimeTypesDB}};
+store(ConfigListEntry, _ConfigList) ->
+    {ok, ConfigListEntry}.
+
+%% Phase 3: Remove
+remove_all(ConfigDB) ->
+    Modules = httpd_util:lookup(ConfigDB,modules,[]),
+    remove_traverse(ConfigDB, lists:append(Modules,[?MODULE])).
+
+remove(ConfigDB) ->
+    ets:delete(ConfigDB),
+    ok.
+
+config(ConfigDB) ->
+    case httpd_util:lookup(ConfigDB,com_type,ip_comm) of
+	ssl ->
+	    case ssl_certificate_file(ConfigDB) of
+		undefined ->
+		    {error,
+		     "Directive SSLCertificateFile "
+		     "not found in the config file"};
+		SSLCertificateFile ->
+		    {ssl,
+		     SSLCertificateFile++
+		     ssl_certificate_key_file(ConfigDB)++
+		     ssl_verify_client(ConfigDB)++
+		     ssl_ciphers(ConfigDB)++
+		     ssl_password(ConfigDB)++
+		     ssl_verify_depth(ConfigDB)++
+		     ssl_ca_certificate_file(ConfigDB)}
+	    end;
+	ip_comm ->
+	    ip_comm
+    end.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+%%% Phase 1 Load:
+bootstrap([]) ->
+    {error, ?NICE("Modules must be specified in the config file")};
+bootstrap([Line|Config]) ->
+    case Line of
+	"Modules " ++ Modules ->
+	    {ok, ModuleList} = regexp:split(Modules," "),
+	    TheMods = [list_to_atom(X) || X <- ModuleList],
+	    case verify_modules(TheMods) of
+		ok ->
+		    {ok, TheMods};
+		{error, Reason} ->
+		    {error, Reason}
+	    end;
+	_ ->
+	    bootstrap(Config)
+    end.
+
+load_config(Config, Modules) ->
+    %% Create default contexts for all modules
+    Contexts = lists:duplicate(length(Modules), []),
+    load_config(Config, Modules, Contexts, []).
+load_config([], _Modules, _Contexts, ConfigList) ->
+    case a_must(ConfigList, [server_name,port,server_root,document_root]) of
+	ok ->
+	    {ok, ConfigList};
+	{missing, Directive} ->
+	    {error, ?NICE(atom_to_list(Directive)++
+			  " must be specified in the config file")}
+    end;
+load_config([Line|Config], Modules, Contexts, ConfigList) ->
+    case load_traverse(Line, Contexts, Modules, [], ConfigList, no) of
+	{ok, NewContexts, NewConfigList} ->
+	    load_config(Config, Modules, NewContexts, NewConfigList);
+	{error, Reason} -> 
+	    {error, Reason}
+    end.
+
+
+%% This loads the config file into each module specified by Modules
+%% Each module has its own context that is passed to and (optionally)
+%% returned by the modules load function. The module can also return
+%% a ConfigEntry, which will be added to the global configuration
+%% list.
+%% All configuration directives are guaranteed to be passed to all
+%% modules. Each module only implements the function clauses of
+%% the load function for the configuration directives it supports,
+%% it's ok if an apply returns {'EXIT', {function_clause, ..}}.
+load_traverse(Line, [], [], _NewContexts, _ConfigList, no) ->
+    {error, ?NICE("Configuration directive not recognized: "++Line)};
+load_traverse(_Line, [], [], NewContexts, ConfigList, yes) ->
+    {ok, lists:reverse(NewContexts), ConfigList};
+load_traverse(Line, [Context|Contexts], [Module|Modules], NewContexts,
+	      ConfigList, State) ->
+    case catch apply(Module, load, [Line, Context]) of
+	{'EXIT', {function_clause, _}} ->
+	    load_traverse(Line, Contexts, Modules, 
+			  [Context|NewContexts], ConfigList, State);
+	{'EXIT',{undef, _}} ->
+	    load_traverse(Line, Contexts, Modules,
+			  [Context|NewContexts], ConfigList,yes);
+	{'EXIT', Reason} ->
+	    error_logger:error_report({'EXIT', Reason}),
+	    load_traverse(Line, Contexts, Modules, 
+			  [Context|NewContexts], ConfigList, State);
+	{ok, NewContext} ->
+	    load_traverse(Line, Contexts, Modules, 
+			  [NewContext|NewContexts], ConfigList,yes);
+	{ok, NewContext, ConfigEntry} when tuple(ConfigEntry) ->
+	    load_traverse(Line, Contexts, Modules, [NewContext|NewContexts],
+			  [ConfigEntry|ConfigList], yes);
+	{ok, NewContext, ConfigEntry} when list(ConfigEntry) ->
+	    load_traverse(Line, Contexts, Modules, [NewContext|NewContexts],
+			  lists:append(ConfigEntry, ConfigList), yes);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+	
+%% Verifies that all specified modules are available.
+verify_modules([]) ->
+    ok;
+verify_modules([Mod|Rest]) ->
+    case code:which(Mod) of
+	non_existing ->
+	    {error, ?NICE(atom_to_list(Mod)++" does not exist")};
+	_Path ->
+	    verify_modules(Rest)
+    end.
+
+%% Reads the entire configuration file and returns list of strings or
+%% and error.
+read_config_file(FileName) ->
+    case file:open(FileName, read) of
+	{ok, Stream} ->
+	    read_config_file(Stream, []);
+	{error, _Reason} ->
+	    {error, ?NICE("Cannot open "++FileName)}
+    end.
+read_config_file(Stream, SoFar) ->
+    case io:get_line(Stream, []) of
+	eof ->
+	    file:close(Stream),
+	    {ok, lists:reverse(SoFar)};
+	{error, Reason} ->
+	    file:close(Stream),
+	    {error, Reason};
+	[$#|_Rest] ->
+	    %% Ignore commented lines for efficiency later ..
+	    read_config_file(Stream, SoFar);
+	Line ->
+	    {ok, NewLine, _}=regexp:sub(clean(Line),"[\t\r\f ]"," "),
+	    case NewLine of
+		[] ->
+		    %% Also ignore empty lines ..
+		    read_config_file(Stream, SoFar);
+		_Other ->
+		    read_config_file(Stream, [NewLine|SoFar])
+	    end
+    end.
+
+parse_mime_types(Stream,MimeTypesList) ->
+    Line=
+	case io:get_line(Stream,'') of
+	    eof ->
+		eof;
+	    String ->
+		clean(String)
+	end,
+    parse_mime_types(Stream, MimeTypesList, Line).
+parse_mime_types(Stream, MimeTypesList, eof) ->
+    file:close(Stream),
+    {ok, MimeTypesList};
+parse_mime_types(Stream, MimeTypesList, "") ->
+    parse_mime_types(Stream, MimeTypesList);
+parse_mime_types(Stream, MimeTypesList, [$#|_]) ->
+    parse_mime_types(Stream, MimeTypesList);
+parse_mime_types(Stream, MimeTypesList, Line) ->
+    case regexp:split(Line, " ") of
+	{ok, [NewMimeType|Suffixes]} ->
+	    parse_mime_types(Stream,
+			     lists:append(suffixes(NewMimeType,Suffixes),
+					  MimeTypesList));
+	{ok, _} ->
+	    {error, ?NICE(Line)}
+    end.
+
+suffixes(_MimeType,[]) ->
+    [];
+suffixes(MimeType,[Suffix|Rest]) ->
+    [{Suffix,MimeType}|suffixes(MimeType,Rest)].
+
+a_must(_ConfigList,[]) ->
+    ok;
+a_must(ConfigList,[Directive|Rest]) ->
+    case httpd_util:key1search(ConfigList,Directive) of
+	undefined ->
+	    {missing,Directive};
+	_ ->
+	    a_must(ConfigList,Rest)
+    end.
+
+%% Pahse 2: store
+store(ConfigDB, _ConfigList, _Modules,[]) ->
+    {ok, ConfigDB};
+store(ConfigDB, ConfigList, Modules, [ConfigListEntry|Rest]) ->
+    case store_traverse(ConfigListEntry,ConfigList,Modules) of
+	{ok, ConfigDBEntry} when tuple(ConfigDBEntry) ->
+	    ets:insert(ConfigDB,ConfigDBEntry),
+	    store(ConfigDB,ConfigList,Modules,Rest);
+	{ok, ConfigDBEntry} when list(ConfigDBEntry) ->
+	    lists:foreach(fun(Entry) ->
+				  ets:insert(ConfigDB,Entry)
+			  end,ConfigDBEntry),
+	    store(ConfigDB,ConfigList,Modules,Rest);
+	{error, Reason} ->
+	    {error,Reason}
+    end.
+
+store_traverse(_ConfigListEntry, _ConfigList,[]) ->
+    {error,?NICE("Unable to store configuration...")};
+store_traverse(ConfigListEntry, ConfigList, [Module|Rest]) ->
+    case catch apply(Module,store,[ConfigListEntry, ConfigList]) of
+	{'EXIT',{function_clause,_}} ->
+	    store_traverse(ConfigListEntry,ConfigList,Rest);
+	{'EXIT',{undef, _}} ->
+	    store_traverse(ConfigListEntry,ConfigList,Rest);
+	{'EXIT', Reason} ->
+	    error_logger:error_report({'EXIT',Reason}),
+	    store_traverse(ConfigListEntry,ConfigList,Rest);
+	Result ->
+	    Result
+    end.
+
+store_mime_types(Name,MimeTypesList) ->
+    %% Make sure that the ets table is not duplicated
+    %% when reloading configuration
+    catch ets:delete(Name),
+    MimeTypesDB = ets:new(Name, [named_table, set, protected]),
+    store_mime_types1(MimeTypesDB, MimeTypesList).
+store_mime_types1(MimeTypesDB,[]) ->
+    {ok, MimeTypesDB};
+store_mime_types1(MimeTypesDB,[Type|Rest]) ->
+    ets:insert(MimeTypesDB, Type),
+    store_mime_types1(MimeTypesDB, Rest).
+
+
+%% Phase 3: remove
+remove_traverse(_ConfigDB,[]) ->
+    ok;
+remove_traverse(ConfigDB,[Module|Rest]) ->
+    case (catch apply(Module,remove,[ConfigDB])) of
+	{'EXIT',{undef,_}} ->
+	    remove_traverse(ConfigDB,Rest);
+	{'EXIT',{function_clause,_}} ->
+	    remove_traverse(ConfigDB,Rest);
+	{'EXIT',Reason} ->
+	    error_logger:error_report({'EXIT',Reason}),
+	    remove_traverse(ConfigDB,Rest);
+	{error,Reason} ->
+	    error_logger:error_report(Reason),
+	    remove_traverse(ConfigDB,Rest);
+	_ ->
+	    remove_traverse(ConfigDB,Rest)
+    end.
+
+ssl_certificate_file(ConfigDB) ->
+    case httpd_util:lookup(ConfigDB,ssl_certificate_file) of
+	undefined ->
+	    undefined;
+	SSLCertificateFile ->
+	    [{certfile,SSLCertificateFile}]
+    end.
+
+ssl_certificate_key_file(ConfigDB) ->
+    case httpd_util:lookup(ConfigDB,ssl_certificate_key_file) of
+	undefined ->
+	    [];
+	SSLCertificateKeyFile ->
+	    [{keyfile,SSLCertificateKeyFile}]
+    end.
+
+ssl_verify_client(ConfigDB) ->
+    case httpd_util:lookup(ConfigDB,ssl_verify_client) of
+	undefined ->
+	    [];
+	SSLVerifyClient ->
+	    [{verify,SSLVerifyClient}]
+    end.
+
+ssl_ciphers(ConfigDB) ->
+    case httpd_util:lookup(ConfigDB,ssl_ciphers) of
+	undefined ->
+	    [];
+	Ciphers ->
+	    [{ciphers, Ciphers}]
+    end.
+
+ssl_password(ConfigDB) ->
+    case httpd_util:lookup(ConfigDB,ssl_password_callback_module) of
+	undefined ->
+	    [];
+	Module ->
+	    case httpd_util:lookup(ConfigDB, 
+				   ssl_password_callback_function) of
+		undefined ->
+		    [];
+		Function ->
+		    case catch apply(Module, Function, []) of
+			Password when list(Password) ->
+			    [{password, Password}];
+			Error ->
+			    error_report(ssl_password,Module,Function,Error),
+			    []
+		    end
+	    end
+    end.
+
+ssl_verify_depth(ConfigDB) ->
+    case httpd_util:lookup(ConfigDB, ssl_verify_client_depth) of
+	undefined ->
+	    [];
+	Depth ->
+	    [{depth, Depth}]
+    end.
+
+ssl_ca_certificate_file(ConfigDB) ->
+    case httpd_util:lookup(ConfigDB, ssl_ca_certificate_file) of
+	undefined ->
+	    [];
+	File ->
+	    [{cacertfile, File}]
+    end.
+
+error_report(Where,M,F,Error) ->
+    error_logger:error_report([{?MODULE, Where}, 
+			       {apply, {M, F, []}}, Error]).
+

Added: incubator/couchdb/trunk/src/couch_inets/httpd_esi.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd_esi.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd_esi.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd_esi.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,106 @@
+%% ``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(httpd_esi).
+
+-export([parse_headers/1, handle_headers/1]).
+
+-include("inets_internal.hrl").
+
+%%%=========================================================================
+%%%  Internal application API 
+%%%=========================================================================
+
+%%--------------------------------------------------------------------------
+%% parse_headers(Data) -> {Headers, Body}
+%%
+%% Data = string() | io_list()
+%% Headers = string()
+%% Body = io_list()
+%%
+%% Description: Parses <Data> and divides it to a header part and a
+%% body part. Note that it is presumed that <Data> starts with a
+%% string including "\r\n\r\n" if there is any header information
+%% present. The returned headers will not contain the HTTP header body
+%% delimiter \r\n. (All header, header delimiters are keept.)
+%% Ex: ["Content-Type : text/html\r\n Connection : closing \r\n\r\n" | 
+%% io_list()] -->  {"Content-Type : text/html\r\n Connection : closing \r\n",
+%% io_list()}
+%%--------------------------------------------------------------------------
+parse_headers(Data) ->
+    parse_headers(Data, []).
+
+%%--------------------------------------------------------------------------
+%% handle_headers(Headers) -> {ok, HTTPHeaders, StatusCode} |
+%%                            {proceed, AbsPath}  
+%%	Headers = string()   
+%%	HTTPHeaders = [{HeaderField, HeaderValue}]
+%%      HeaderField = string()
+%%      HeaderValue = string() 
+%%      StatusCode = integer()
+%% 
+%% Description: Transforms the plain HTTP header string data received
+%% from the ESI program into a list of header values and an
+%% appropriate HTTP status code. Note if a location header is present
+%% the return value will be {proceed, AbsPath}
+%%--------------------------------------------------------------------------
+handle_headers("") ->
+    {ok, [], 200};
+handle_headers(Headers) ->
+    NewHeaders = string:tokens(Headers, ?CRLF),
+    handle_headers(NewHeaders, [], 200).
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+parse_headers([], Acc) ->
+    {[], lists:reverse(Acc)};
+parse_headers([?CR, ?LF, ?CR, ?LF], Acc) ->
+    {lists:reverse(Acc) ++ [?CR, ?LF], []};
+parse_headers([?CR, ?LF, ?CR, ?LF | Rest], Acc) ->
+    {lists:reverse(Acc) ++ [?CR, ?LF], Rest};
+parse_headers([Char | Rest], Acc) ->
+    parse_headers(Rest, [Char | Acc]).
+ 
+handle_headers([], NewHeaders, StatusCode) ->
+    {ok, NewHeaders, StatusCode};
+
+handle_headers([Header | Headers], NewHeaders, StatusCode) -> 
+    {FieldName, FieldValue} = httpd_response:split_header(Header, []),
+    case FieldName of
+	"location" ->
+	    case http_request:is_absolut_uri(FieldValue) of
+		true ->
+		    handle_headers(Headers, 
+				   [{FieldName, FieldValue} | NewHeaders], 
+				   302);
+		false ->
+		    {proceed, FieldValue}
+	    end;
+	"status" ->
+	    NewStatusCode = 
+		case httpd_util:split(FieldValue," ",2) of
+		    {ok,[Code,_]} ->
+			list_to_integer(Code);
+		    _ ->
+			200
+		end,
+	    handle_headers(Headers, NewHeaders, NewStatusCode);
+	_ -> 
+	    handle_headers(Headers, 
+			     [{FieldName, FieldValue}| NewHeaders], StatusCode)
+    end.	

Added: incubator/couchdb/trunk/src/couch_inets/httpd_example.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd_example.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd_example.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd_example.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,143 @@
+%% ``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(httpd_example).
+-export([print/1]).
+-export([get/2, post/2, yahoo/2, test1/2, get_bin/2]).
+
+-export([newformat/3]).
+%% These are used by the inets test-suite
+-export([delay/1]).
+
+
+print(String) ->
+  [header(),
+   top("Print"),
+   String++"\n",
+   footer()].
+
+test1(Env, []) ->
+    io:format("Env:~p~n",[Env]),
+    ["<html>",
+     "<head>",
+     "<title>Test1</title>",
+     "</head>",
+     "<body>",
+     "<h1>Erlang Body</h1>",
+     "<h2>Stuff</h2>",
+     "</body>",
+     "</html>"].
+
+
+get(_Env,[]) ->
+  [header(),
+   top("GET Example"),
+   "<FORM ACTION=\"/cgi-bin/erl/httpd_example:get\" METHOD=GET>	
+<B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\">
+<INPUT TYPE=\"text\" NAME=\"input2\">
+<INPUT TYPE=\"submit\"><BR>
+</FORM>" ++ "\n",
+   footer()];
+
+get(Env,Input) ->
+  default(Env,Input).
+
+get_bin(_Env,_Input) ->
+    [list_to_binary(header()),
+     list_to_binary(top("GET Example")),
+     list_to_binary("<FORM ACTION=\"/cgi-bin/erl/httpd_example:get\" METHOD=GET>	
+<B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\">
+<INPUT TYPE=\"text\" NAME=\"input2\">
+<INPUT TYPE=\"submit\"><BR>
+</FORM>" ++ "\n"),
+   footer()].
+
+post(_Env,[]) ->
+  [header(),
+   top("POST Example"),
+   "<FORM ACTION=\"/cgi-bin/erl/httpd_example:post\" METHOD=POST>	
+<B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\">
+<INPUT TYPE=\"text\" NAME=\"input2\">
+<INPUT TYPE=\"submit\"><BR>
+</FORM>" ++ "\n",
+   footer()];
+
+post(Env,Input) ->
+  default(Env,Input).
+
+yahoo(_Env,_Input) ->
+  "Location: http://www.yahoo.com\r\n\r\n".
+
+default(Env,Input) ->
+  [header(),
+   top("Default Example"),
+   "<B>Environment:</B> ",io_lib:format("~p",[Env]),"<BR>\n",
+   "<B>Input:</B> ",Input,"<BR>\n",
+   "<B>Parsed Input:</B> ",
+   io_lib:format("~p",[httpd:parse_query(Input)]),"\n",
+   footer()].
+
+header() ->
+  header("text/html").
+header(MimeType) ->
+  "Content-type: " ++ MimeType ++ "\r\n\r\n".
+
+top(Title) ->
+  "<HTML>
+<HEAD>
+<TITLE>" ++ Title ++ "</TITLE>
+</HEAD>
+<BODY>\n".
+
+footer() ->
+  "</BODY>
+</HTML>\n".
+
+    
+newformat(SessionID, _Env, _Input)->
+    mod_esi:deliver(SessionID, "Content-Type:text/html\r\n\r\n"),
+    mod_esi:deliver(SessionID, top("new esi format test")),
+    mod_esi:deliver(SessionID, "This new format is nice<BR>"),
+    mod_esi:deliver(SessionID, "This new format is nice<BR>"),
+    mod_esi:deliver(SessionID, "This new format is nice<BR>"),
+    mod_esi:deliver(SessionID, footer()).
+    
+%% ------------------------------------------------------
+
+delay(Time) when integer(Time) ->
+    i("httpd_example:delay(~p) -> do the delay",[Time]),
+    sleep(Time),
+    i("httpd_example:delay(~p) -> done, now reply",[Time]),
+    delay_reply("delay ok");
+delay(Time) when list(Time) ->
+    delay(httpd_conf:make_integer(Time));
+delay({ok,Time}) when integer(Time) ->
+    delay(Time);
+delay({error,_Reason}) ->
+    i("delay -> called with invalid time"),
+    delay_reply("delay failed: invalid delay time").
+
+delay_reply(Reply) ->
+    [header(),
+     top("delay"),
+     Reply,
+     footer()].
+
+i(F)   -> i(F,[]).
+i(F,A) -> io:format(F ++ "~n",A).
+
+sleep(T) -> receive after T -> ok end.

Added: incubator/couchdb/trunk/src/couch_inets/httpd_instance_sup.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd_instance_sup.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd_instance_sup.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd_instance_sup.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,193 @@
+%% ``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$
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for an instance of the http server. (You may
+%%          have several instances running on the same machine.) Hangs under
+%%          httpd_sup.
+%%----------------------------------------------------------------------
+
+-module(httpd_instance_sup).
+
+-behaviour(supervisor).
+
+-export([init/1]).
+
+%% Internal API
+-export([start/1, start_link/1, start_link/3, start2/1, start_link2/1, 
+	 stop/1, stop/2, stop2/1]).
+
+%%%=========================================================================
+%%%  Supervisor callback
+%%%=========================================================================
+init([ConfigFile, ConfigList, AcceptTimeout, Debug, Addr, Port]) -> 
+    httpd_util:enable_debug(Debug),
+    Flags = {one_for_one, 0, 1},
+    Children  = [sup_spec(httpd_acceptor_sup, Addr, Port), 
+		 sup_spec(httpd_misc_sup, Addr, Port), 
+		 worker_spec(httpd_manager, Addr, Port, 
+			     ConfigFile, ConfigList,AcceptTimeout)],
+    {ok, {Flags, Children}}.
+
+
+%%%=========================================================================
+%%%  ??? functions
+%%%=========================================================================
+
+start(ConfigFile) ->
+    case start_link(ConfigFile) of
+	{ok, Pid} ->
+	    unlink(Pid),
+	    {ok, Pid};
+
+	Else ->
+	    Else
+    end.
+
+start_link(Config) ->
+    case catch httpd_options(Config) of
+	{error,Reason} ->
+	    error_logger:error_report(Reason),
+	    {stop, Reason};
+	{ConfigFile,AcceptTimeout,Debug} -> 
+	    start_link(ConfigFile, AcceptTimeout, Debug)
+    end.
+start_link(ConfigFile, AcceptTimeout, Debug) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok, ConfigList, Addr, Port} ->
+	    Name    = make_name(Addr, Port),
+	    SupName = {local, Name},
+	    supervisor:start_link(SupName, ?MODULE, 
+				  [ConfigFile, ConfigList ,AcceptTimeout ,
+				   Debug, Addr, Port]);	
+	{error, Reason} ->
+	    error_logger:error_report(Reason),
+	    {stop, Reason}
+    end.
+
+    
+start2(ConfigList) ->
+    case start_link2(ConfigList) of
+	{ok, Pid} ->
+	    unlink(Pid),
+	    {ok, Pid};
+
+	Else ->
+	    Else
+    end.
+
+    
+start_link2(ConfigList) ->
+    {ok, Addr, Port} = get_addr_and_port2(ConfigList),
+    Name    = make_name(Addr, Port),
+    SupName = {local, Name},
+    Debug = [],
+    AcceptTimeout = 15000,
+    supervisor:start_link(SupName, ?MODULE, 
+			  [undefined, ConfigList, AcceptTimeout, 
+			   Debug, Addr, Port]).
+    
+
+stop(Pid) when pid(Pid) ->
+    do_stop(Pid);
+stop(ConfigFile) when list(ConfigFile) ->
+    case get_addr_and_port(ConfigFile) of
+	{ok, _, Addr, Port} ->
+	    stop(Addr, Port);
+	    
+	Error ->
+	    Error
+    end;
+stop(_StartArgs) ->
+    ok.
+
+
+stop(Addr, Port) when integer(Port) ->
+    Name = make_name(Addr, Port), 
+    case whereis(Name) of
+	Pid when pid(Pid) ->
+	    do_stop(Pid),
+	    ok;
+	_ ->
+	    not_started
+    end.
+    
+
+stop2(ConfigList) when list(ConfigList) ->
+    {ok, Addr, Port} = get_addr_and_port2(ConfigList),
+    stop(Addr, Port).
+
+%%%=========================================================================
+%%%  Internal functions
+%%%=========================================================================
+do_stop(Pid) ->
+    exit(Pid, shutdown).
+
+sup_spec(SupModule, Addr, Port) ->
+    Name = {SupModule, Addr, Port},
+    StartFunc = {SupModule, start_link, [Addr, Port]},
+    Restart = permanent, 
+    Shutdown = infinity,
+    Modules = [SupModule],
+    Type = supervisor,
+    {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+    
+worker_spec(WorkerModule, Addr, Port, ConfigFile, ConfigList, AcceptTimeout) ->
+    Name = {WorkerModule, Addr, Port},
+    StartFunc = {WorkerModule, start_link, 
+		 [ConfigFile, ConfigList, AcceptTimeout]}, 
+    Restart = permanent, 
+    Shutdown = 4000,
+    Modules = [WorkerModule],
+    Type = worker,
+    {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+httpd_options(Config) ->
+    OptionList = mk_tuple_list(Config),
+    Debug = http_util:key1search(OptionList,debug,[]),
+    AcceptTimeout = http_util:key1search(OptionList,accept_timeout,15000),
+    ConfigFile =
+    case http_util:key1search(OptionList,file) of
+	undefined -> throw({error,{mandatory_conf_file_missed}});
+	File -> File
+    end,
+    httpd_util:valid_options(Debug,AcceptTimeout,ConfigFile),
+    {ConfigFile, AcceptTimeout, Debug}.
+
+mk_tuple_list([]) -> 
+    [];
+mk_tuple_list([H={_,_}|T]) -> 
+    [H|mk_tuple_list(T)];
+mk_tuple_list(F) when list(F) ->
+    [{file,F}].
+
+make_name(Addr,Port) ->
+    httpd_util:make_name("httpd_instance_sup",Addr,Port).
+
+get_addr_and_port(ConfigFile) ->
+    case httpd_conf:load(ConfigFile) of
+	{ok, ConfigList} ->
+	    {ok, Addr, Port} = get_addr_and_port2(ConfigList),
+	    {ok, ConfigList, Addr, Port};
+	Error ->
+	    Error
+    end.
+
+get_addr_and_port2(ConfigList) ->
+    Port = httpd_util:key1search(ConfigList, port, 80),
+    Addr = httpd_util:key1search(ConfigList, bind_address),
+    {ok, Addr, Port}.



Mime
View raw message