Mailing-List: contact couchdb-commits-help@incubator.apache.org; run by ezmlm
Precedence: bulk
Reply-To: couchdb-dev@incubator.apache.org
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: svn commit: r642432 [10/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/ ...
Date: Fri, 28 Mar 2008 23:32:30 -0000
To: couchdb-commits@incubator.apache.org
From: cmlenz@apache.org
Message-Id: <20080328233247.A79441A985D@eris.apache.org>

Added: incubator/couchdb/trunk/src/couch_inets/mod_auth_plain.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_auth_plain.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_auth_plain.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_auth_plain.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,295 @@
+%% ``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(mod_auth_plain).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+-define(VMODULE,"AUTH_PLAIN").
+
+%% Internal API
+-export([store_directory_data/2]).
+
+
+-export([get_user/2, 
+	 list_group_members/2, 
+	 add_user/2, 
+	 add_group_member/3, 
+	 list_users/1, 
+	 delete_user/2, 
+	 list_groups/1, 
+	 delete_group_member/3, 
+	 delete_group/2, 
+	 remove/1]).
+
+%%
+%% API
+%%
+
+%%
+%% Storage format of users in the ets table:
+%% {UserName, Password, UserData}
+%%
+
+add_user(DirData, #httpd_user{username = User} = UStruct) ->
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    Record = {User,
+	      UStruct#httpd_user.password, 
+	      UStruct#httpd_user.user_data}, 
+    case ets:lookup(PWDB, User) of
+	[{User, _SomePassword, _SomeData}] ->
+	    {error, user_already_in_db};
+	_ ->
+	    ets:insert(PWDB, Record),
+	    true
+    end.
+
+get_user(DirData, User) ->
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    case ets:lookup(PWDB, User) of
+	[{User, PassWd, Data}] ->
+	    {ok, #httpd_user{username=User, password=PassWd, user_data=Data}};
+	_ ->
+	    {error, no_such_user}
+    end.
+
+list_users(DirData) ->
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    Records = ets:match(PWDB, '$1'), 
+    {ok, lists:foldr(fun({User, _PassWd, _Data}, A) -> [User | A] end, 
+		     [], lists:flatten(Records))}.
+
+delete_user(DirData, UserName) ->
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    case ets:lookup(PWDB, UserName) of
+	[{UserName, _SomePassword, _SomeData}] ->
+	    ets:delete(PWDB, UserName),
+	    {ok, Groups}  = list_groups(DirData),
+	    lists:foreach(fun(Group) -> 
+				  delete_group_member(DirData, 
+						      Group, UserName) 
+			  end, Groups);
+	_ ->
+	    {error, no_such_user}
+    end.
+
+%%
+%% Storage of groups in the ets table:
+%% {Group, UserList} where UserList is a list of strings.
+%%
+  
+add_group_member(DirData, Group, UserName) ->
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    case ets:lookup(GDB, Group) of
+	[{Group, Users}] ->
+	    case lists:member(UserName, Users) of
+		true ->
+		    true;
+		false ->
+		    ets:insert(GDB, {Group, [UserName|Users]}),
+		    true
+	    end;
+	[] ->
+	    ets:insert(GDB, {Group, [UserName]}),
+	    true;
+	Other ->
+	    {error, Other}
+    end.
+
+list_group_members(DirData, Group) ->
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    case ets:lookup(GDB, Group) of
+	[{Group, Users}] ->
+	    {ok, Users};
+	_ ->
+	    {error, no_such_group}
+    end.
+
+list_groups(DirData) ->
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    Groups = ets:match(GDB, '$1'), 
+    {ok, httpd_util:uniq(lists:foldr(fun({G, _}, A) -> [G|A] end,
+				     [], lists:flatten(Groups)))}.
+
+delete_group_member(DirData, Group, User) ->
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    case ets:lookup(GDB, Group) of
+	[{Group, Users}] when is_list(Users) ->
+	    case lists:member(User, Users) of
+		true ->
+		    ets:delete(GDB, Group),
+		    ets:insert(GDB, {Group, lists:delete(User, Users)}),
+		    true;
+		false ->
+		    {error, no_such_group_member}
+	    end;
+	_ ->
+	    {error, no_such_group}
+    end.
+
+delete_group(DirData, Group) ->
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    case ets:lookup(GDB, Group) of
+	[{Group, _Users}] ->
+	    ets:delete(GDB, Group),
+	    true;
+	_ ->
+	    {error, no_such_group}
+    end.
+
+store_directory_data(_Directory, DirData) ->
+    PWFile = httpd_util:key1search(DirData, auth_user_file),
+    GroupFile = httpd_util:key1search(DirData, auth_group_file),
+    case load_passwd(PWFile) of
+	{ok, PWDB} ->
+	    case load_group(GroupFile) of
+		{ok, GRDB} ->
+		    %% Address and port is included in the file names...
+		    Addr = httpd_util:key1search(DirData, bind_address),
+		    Port = httpd_util:key1search(DirData, port),
+		    {ok, PasswdDB} = store_passwd(Addr,Port,PWDB),
+		    {ok, GroupDB}  = store_group(Addr,Port,GRDB),
+		    NDD1 = lists:keyreplace(auth_user_file, 1, DirData, 
+					    {auth_user_file, PasswdDB}),
+		    NDD2 = lists:keyreplace(auth_group_file, 1, NDD1, 
+					    {auth_group_file, GroupDB}),
+		    {ok, NDD2};
+		Err ->
+		    {error, Err}
+	    end;
+	Err2 ->
+	    {error, Err2}
+    end.
+
+
+
+%% load_passwd
+
+load_passwd(AuthUserFile) ->
+    case file:open(AuthUserFile, read) of
+	{ok,Stream} ->
+	    parse_passwd(Stream, []);
+	{error, _} ->
+	    {error, ?NICE("Can't open "++AuthUserFile)}
+    end.
+
+parse_passwd(Stream,PasswdList) ->
+    Line =
+	case io:get_line(Stream, '') of
+	    eof ->
+		eof;
+	    String ->
+		httpd_conf:clean(String)
+	end,
+    parse_passwd(Stream, PasswdList, Line).
+
+parse_passwd(Stream, PasswdList, eof) ->
+    file:close(Stream),
+    {ok, PasswdList};
+parse_passwd(Stream, PasswdList, "") ->
+    parse_passwd(Stream, PasswdList);
+parse_passwd(Stream, PasswdList, [$#|_]) ->
+    parse_passwd(Stream, PasswdList);
+parse_passwd(Stream, PasswdList, Line) ->      
+    case regexp:split(Line,":") of
+	{ok, [User,Password]} ->
+	    parse_passwd(Stream, [{User,Password, []}|PasswdList]);
+	{ok,_} ->
+	    {error, ?NICE(Line)}
+    end.
+
+%% load_group
+
+load_group(AuthGroupFile) ->
+    case file:open(AuthGroupFile, read) of
+	{ok, Stream} ->
+	    parse_group(Stream,[]);
+	{error, _} ->
+	    {error, ?NICE("Can't open "++AuthGroupFile)}
+    end.
+
+parse_group(Stream, GroupList) ->
+    Line=
+	case io:get_line(Stream,'') of
+	    eof ->
+		eof;
+	    String ->
+		httpd_conf:clean(String)
+	end,
+    parse_group(Stream, GroupList, Line).
+
+parse_group(Stream, GroupList, eof) ->
+    file:close(Stream),
+    {ok, GroupList};
+parse_group(Stream, GroupList, "") ->
+    parse_group(Stream, GroupList);
+parse_group(Stream, GroupList, [$#|_]) ->
+    parse_group(Stream, GroupList);
+parse_group(Stream, GroupList, Line) ->      
+    case regexp:split(Line, ":") of
+	{ok, [Group,Users]} ->
+	    {ok, UserList} = regexp:split(Users," "),
+	    parse_group(Stream, [{Group,UserList}|GroupList]);
+	{ok, _} ->
+	    {error, ?NICE(Line)}
+    end.
+
+
+%% store_passwd
+
+store_passwd(Addr,Port,PasswdList) ->
+    Name = httpd_util:make_name("httpd_passwd",Addr,Port),
+    PasswdDB = ets:new(Name, [set, public]),
+    store_passwd(PasswdDB, PasswdList).
+
+store_passwd(PasswdDB, []) ->
+    {ok, PasswdDB};
+store_passwd(PasswdDB, [User|Rest]) ->
+    ets:insert(PasswdDB, User),
+    store_passwd(PasswdDB, Rest).
+
+%% store_group
+
+store_group(Addr,Port,GroupList) ->
+    Name = httpd_util:make_name("httpd_group",Addr,Port),
+    GroupDB = ets:new(Name, [set, public]),
+    store_group(GroupDB, GroupList).
+
+
+store_group(GroupDB,[]) ->
+    {ok, GroupDB};
+store_group(GroupDB,[User|Rest]) ->
+    ets:insert(GroupDB, User),
+    store_group(GroupDB, Rest).
+
+
+%% remove/1
+%%
+%% Deletes ets tables used by this auth mod.
+%%
+remove(DirData) ->
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    ets:delete(PWDB),
+    ets:delete(GDB).
+
+
+
+
+
+

Added: incubator/couchdb/trunk/src/couch_inets/mod_auth_server.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_auth_server.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_auth_server.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_auth_server.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,374 @@
+%% ``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(mod_auth_server).
+
+-include("httpd.hrl").
+
+-behaviour(gen_server).
+
+
+%% mod_auth exports 
+-export([start/2, stop/2, 
+	 add_password/4, update_password/5, 
+	 add_user/5, delete_user/5, get_user/5, list_users/4, 
+	 add_group_member/6, delete_group_member/6, list_group_members/5, 
+	 delete_group/5, list_groups/4]).
+
+%% gen_server exports
+-export([start_link/2, init/1,
+	 handle_call/3, handle_cast/2, handle_info/2,
+	 terminate/2, code_change/3]).
+
+%% We will not make the change to use base64 in stdlib in inets just yet.
+%% it will be included in the next major release of inets. 
+-compile({nowarn_deprecated_function, {http_base_64, encode, 1}}).
+
+-record(state,{tab}).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                  %%
+%% External API                                                     %%
+%%                                                                  %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% start_link/3
+%% 
+%% NOTE: This is called by httpd_misc_sup when the process is started
+%% 
+start_link(Addr, Port)->
+    Name = make_name(Addr, Port),
+    gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]).
+
+
+%% start/2
+
+start(Addr, Port)->
+    Name = make_name(Addr, Port),
+    case whereis(Name) of
+	undefined ->
+	    httpd_misc_sup:start_auth_server(Addr, Port);
+	_ -> %% Already started...
+	    ok
+    end.
+
+
+%% stop/2
+
+stop(Addr, Port)->
+    Name = make_name(Addr, Port),
+    case whereis(Name) of
+	undefined -> %% Already stopped
+	    ok;
+	_ ->
+           (catch httpd_misc_sup:stop_auth_server(Addr, Port))
+    end.
+
+%% add_password/4
+
+add_password(Addr, Port, Dir, Password)->
+    Name = make_name(Addr, Port),
+    Req  = {add_password, Dir, Password},
+    call(Name, Req).
+
+
+%% update_password/6
+
+update_password(Addr, Port, Dir, Old, New) when list(New) ->
+    Name = make_name(Addr, Port),
+    Req  = {update_password, Dir, Old, New},
+    call(Name, Req).
+	   
+ 
+%% add_user/5
+
+add_user(Addr, Port, Dir, User, Password) ->
+    Name = make_name(Addr, Port),
+    Req  = {add_user, Addr, Port, Dir, User, Password},
+    call(Name, Req).
+
+
+%% delete_user/5
+
+delete_user(Addr, Port, Dir, UserName, Password) ->
+    Name = make_name(Addr, Port),
+    Req  = {delete_user, Addr, Port, Dir, UserName, Password},
+    call(Name, Req).
+
+
+%% get_user/5
+
+get_user(Addr, Port, Dir, UserName, Password) ->
+    Name = make_name(Addr, Port),
+    Req  = {get_user, Addr, Port, Dir, UserName, Password},
+    call(Name, Req).
+
+
+%% list_users/4
+
+list_users(Addr, Port, Dir, Password) ->
+    Name = make_name(Addr,Port),
+    Req  = {list_users, Addr, Port, Dir, Password},
+    call(Name, Req).
+
+
+%% add_group_member/6
+
+add_group_member(Addr, Port, Dir, GroupName, UserName, Password) ->
+    Name = make_name(Addr,Port),
+    Req  = {add_group_member, Addr, Port, Dir, GroupName, UserName, Password},
+    call(Name, Req).
+
+
+%% delete_group_member/6
+
+delete_group_member(Addr, Port, Dir, GroupName, UserName, Password) ->
+    Name = make_name(Addr,Port),
+    Req  = {delete_group_member, Addr, Port, Dir, GroupName, UserName, Password},
+    call(Name, Req).
+
+
+%% list_group_members/4
+
+list_group_members(Addr, Port, Dir, Group, Password) ->
+    Name = make_name(Addr, Port),
+    Req  = {list_group_members, Addr, Port, Dir, Group, Password},
+    call(Name, Req).
+
+
+%% delete_group/5
+
+delete_group(Addr, Port, Dir, GroupName, Password) ->
+    Name = make_name(Addr, Port),
+    Req  = {delete_group, Addr, Port, Dir, GroupName, Password},
+    call(Name, Req).
+
+
+%% list_groups/4
+
+list_groups(Addr, Port, Dir, Password) ->
+    Name = make_name(Addr, Port),
+    Req  = {list_groups, Addr, Port, Dir, Password},
+    call(Name, Req).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                  %%
+%% Server call-back functions                                       %%
+%%                                                                  %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% init
+
+init(_) ->
+    {ok,#state{tab = ets:new(auth_pwd,[set,protected])}}.
+
+%% handle_call
+
+%% Add a user
+handle_call({add_user, Addr, Port, Dir, User, AuthPwd}, _From, State) ->
+    Reply = api_call(Addr, Port, Dir, add_user, User, AuthPwd, State),
+    {reply, Reply, State};
+
+%% Get data about a user
+handle_call({get_user, Addr, Port, Dir, User, AuthPwd}, _From, State) ->
+    Reply = api_call(Addr, Port, Dir, get_user, [User], AuthPwd, State),
+    {reply, Reply, State};
+
+%% Add a group member
+handle_call({add_group_member, Addr, Port, Dir, Group, User, AuthPwd},
+	    _From, State) ->
+    Reply = api_call(Addr, Port, Dir, add_group_member, [Group, User], 
+		     AuthPwd, State),
+    {reply, Reply, State};
+
+%% delete a group
+handle_call({delete_group_member, Addr, Port, Dir, Group, User, AuthPwd},
+	    _From, State)->
+    Reply = api_call(Addr, Port, Dir, delete_group_member, [Group, User], 
+		     AuthPwd, State), 
+    {reply, Reply, State};
+
+%% List all users thats standalone users
+handle_call({list_users, Addr, Port, Dir, AuthPwd}, _From, State)->
+    Reply = api_call(Addr, Port, Dir, list_users, [], AuthPwd, State),
+    {reply, Reply, State};
+
+%% Delete a user
+handle_call({delete_user, Addr, Port, Dir, User, AuthPwd}, _From, State)->
+    Reply = api_call(Addr, Port, Dir, delete_user, [User], AuthPwd, State),
+    {reply, Reply, State};
+
+%% Delete a group
+handle_call({delete_group, Addr, Port, Dir, Group, AuthPwd}, _From, State)->
+    Reply = api_call(Addr, Port, Dir, delete_group, [Group], AuthPwd, State),
+    {reply, Reply, State};
+
+%% List the current groups
+handle_call({list_groups, Addr, Port, Dir, AuthPwd}, _From, State)->
+    Reply = api_call(Addr, Port, Dir, list_groups, [], AuthPwd, State),
+    {reply, Reply, State};
+
+%% List the members of the given group
+handle_call({list_group_members, Addr, Port, Dir, Group, AuthPwd},
+	    _From, State)->
+    Reply = api_call(Addr, Port, Dir, list_group_members, [Group],
+		     AuthPwd, State), 
+    {reply, Reply, State};
+
+
+%% Add password for a directory
+handle_call({add_password, Dir, Password}, _From, State)->
+    Reply = do_add_password(Dir, Password, State),
+    {reply, Reply, State};
+
+
+%% Update the password for a directory
+  
+handle_call({update_password, Dir, Old, New},_From,State)->
+    Reply = 
+	case getPassword(State, Dir) of
+	    OldPwd when binary(OldPwd)->
+		case erlang:md5(Old) of
+		    OldPwd ->
+			%% The old password is right =>
+			%% update the password to the new
+			do_update_password(Dir,New,State),
+			ok;
+		_->
+		    {error, error_new}
+	    end;
+	_->
+	    {error, error_old}
+    end,
+    {reply, Reply, State};
+
+handle_call(stop, _From, State)->
+    {stop, normal, State}.
+
+handle_info(_Info, State)->
+    {noreply, State}.
+
+handle_cast(_Request, State)->
+    {noreply, State}.
+    
+
+terminate(_Reason,State) ->
+    ets:delete(State#state.tab),
+    ok.
+
+
+%% code_change({down, ToVsn}, State, Extra)
+%% 
+code_change({down, _}, #state{tab = Tab}, downgrade_to_2_6_0) ->
+    {ok, {state, Tab, undefined}};
+
+
+%% code_change(FromVsn, State, Extra)
+%%
+code_change(_, {state, Tab, _}, upgrade_from_2_6_0) ->
+    {ok, #state{tab = Tab}}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                  %%
+%% The functions that really changes the data in the database       %%
+%% of users to different directories                                %%
+%%                                                                  %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
+
+%% API gateway
+
+api_call(Addr, Port, Dir, Func, Args,Password,State) ->
+    case controlPassword(Password,State,Dir) of
+	ok->
+	    ConfigName = httpd_util:make_name("httpd_conf",Addr,Port),
+	    case ets:match_object(ConfigName, {directory, Dir, '$1'}) of
+		[{directory, Dir, DirData}] ->
+		    AuthMod = auth_mod_name(DirData),
+		    (catch apply(AuthMod, Func, [DirData|Args]));
+		_ ->
+		    {error, no_such_directory}
+	    end;
+	bad_password ->
+	    {error,bad_password}
+    end.
+
+controlPassword(Password, _State, _Dir) when Password=:="DummyPassword"->
+    bad_password;
+
+controlPassword(Password,State,Dir)->
+    case getPassword(State,Dir) of
+	Pwd when binary(Pwd)->
+	    case erlang:md5(Password) of
+		Pwd ->
+		    ok;
+		_->
+		    bad_password
+	    end;
+	_ ->
+	    bad_password
+    end.
+
+    
+getPassword(State,Dir)->
+    case lookup(State#state.tab, Dir) of
+	[{_,Pwd}]->
+	    Pwd;
+	_ ->
+	    {error,bad_password}
+    end.
+
+do_update_password(Dir, New, State) ->
+    ets:insert(State#state.tab, {Dir, erlang:md5(New)}).
+
+do_add_password(Dir, Password, State) ->
+    case getPassword(State,Dir) of
+	PwdExists when binary(PwdExists) ->
+	    {error, dir_protected};
+	{error, _} ->
+	    do_update_password(Dir, Password, State)
+    end.
+	    
+
+auth_mod_name(DirData) ->
+    case httpd_util:key1search(DirData, auth_type, plain) of
+	plain ->    mod_auth_plain;
+	mnesia ->   mod_auth_mnesia;
+	dets ->	    mod_auth_dets
+    end.
+
+    
+lookup(Db, Key) ->
+    ets:lookup(Db, Key).
+
+
+make_name(Addr,Port) ->
+    httpd_util:make_name("httpd_auth",Addr,Port).
+
+
+call(Name, Req) ->
+    case (catch gen_server:call(Name, Req)) of
+	{'EXIT', Reason} ->
+	    {error, Reason};
+	Reply ->
+	    Reply
+    end.
+    
+

Added: incubator/couchdb/trunk/src/couch_inets/mod_browser.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_browser.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_browser.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_browser.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,247 @@
+%% ``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$
+%%
+%% ----------------------------------------------------------------------
+%%
+%% Browsers sends a string to the webbserver
+%% to identify themsevles. They are a bit nasty
+%% since the only thing that the specification really 
+%% is strict about is that they shall be short
+%% some axamples:
+%%
+%% Netscape Mozilla/4.75 [en] (X11; U; SunOS 5.8 sun4u)
+%%          Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0
+%% Mozilla  Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.1) Gecko/20020827
+%% Safari   Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85 (KHTML, like Gecko) Safari/85
+%% IE5      Mozilla/4.0 (compatible; MSIE 5.0; SP1B; SunOS 5.8 sun4u; X11)
+%% Lynx     Lynx/2.8.3rel.1 libwww-FM/2.142
+%%
+%% ----------------------------------------------------------------------
+
+-module(mod_browser).
+
+-export([do/1, test/0, getBrowser/1]).
+
+%% Remember that the order of the mozilla browsers are 
+%% important since some browsers include others to behave 
+%% as they were something else  
+-define(MOZILLA_BROWSERS,[{netscape, "netscape"},
+			  {opera,    "opera"}, 
+			  {msie,     "msie"}, 
+			  {safari,   "safari"},
+			  {mozilla,  "rv:"}]). % fallback, must be last
+
+
+%% If your operatingsystem is not recognized add it to this list.
+-define(OPERATIVE_SYSTEMS,[{win3x,  ["win16", "windows 3", "windows 16-bit"]},
+			   {win95,  ["win95", "windows 95"]},
+			   {win98,  ["win98", "windows 98"]},
+			   {winnt,  ["winnt", "windows nt"]},
+			   {win2k,  ["nt 5"]},
+			   {sunos4, ["sunos 4"]},
+			   {sunos5, ["sunos 5"]},
+			   {sun,    ["sunos"]},
+			   {aix,    ["aix"]},
+			   {linux,  ["linux"]},
+			   {sco,    ["sco", "unix_sv"]},
+			   {freebsd,["freebsd"]},
+			   {bsd,    ["bsd"]},
+			   {macosx, ["mac os x"]}]).
+
+-define(LYNX,       lynx).
+-define(MOZILLA,    mozilla).
+-define(EMACS,      emacs).
+-define(STAROFFICE, soffice).
+-define(MOSAIC,     mosaic).
+-define(NETSCAPE,   netscape).
+-define(SAFARU,     safari).
+-define(UNKOWN,     unknown).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"BROWSER").
+
+do(Info) ->
+    case httpd_util:key1search(Info#mod.data,status) of
+	{_StatusCode, _PhraseArgs, _Reason} ->
+	    {proceed,Info#mod.data};
+	undefined ->
+	    Browser = getBrowser1(Info),
+	    {proceed,[{'user-agent', Browser}|Info#mod.data]}
+    end.
+
+getBrowser1(Info) ->
+    PHead = Info#mod.parsed_header,
+    case httpd_util:key1search(PHead,"user-agent") of
+	undefined ->
+	    undefined;
+	AgentString ->
+	    getBrowser(AgentString)
+    end.
+
+getBrowser(AgentString) ->
+    LAgentString = http_util:to_lower(AgentString),
+    case regexp:first_match(LAgentString,"^[^ ]*") of
+	{match,Start,Length} ->
+	    Browser = lists:sublist(LAgentString,Start,Length),
+	    case browserType(Browser) of
+		{mozilla,Vsn} ->
+		    {getMozilla(LAgentString,
+				?MOZILLA_BROWSERS,{?NETSCAPE,Vsn}),
+		     operativeSystem(LAgentString)};
+		AnyBrowser ->
+		      {AnyBrowser,operativeSystem(LAgentString)}
+	    end;
+	nomatch ->
+	    browserType(LAgentString)
+    end.
+
+browserType([$l,$y,$n,$x|Version]) ->
+    {?LYNX,browserVersion(Version)};
+browserType([$m,$o,$z,$i,$l,$l,$a|Version]) ->
+    {?MOZILLA,browserVersion(Version)};
+browserType([$e,$m,$a,$c,$s|Version]) ->
+    {?EMACS,browserVersion(Version)};
+browserType([$s,$t,$a,$r,$o,$f,$f,$i,$c,$e|Version]) ->
+    {?STAROFFICE,browserVersion(Version)};
+browserType([$m,$o,$s,$a,$i,$c|Version]) ->
+    {?MOSAIC,browserVersion(Version)};
+browserType(_Unknown) ->
+    unknown.
+ 
+
+browserVersion([$/|VsnString]) ->
+    case catch list_to_float(VsnString) of
+	Number when float(Number) ->
+	    Number;
+	_Whatever ->
+	    case string:span(VsnString,"1234567890.") of
+		0 ->
+		    unknown;
+		VLength ->
+		    Vsn = string:substr(VsnString,1,VLength),
+		    case string:tokens(Vsn,".") of
+			[Number] ->
+			   list_to_float(Number++".0");
+			[Major,Minor|_MinorMinor] ->
+			    list_to_float(Major++"."++Minor)
+		    end
+	    end
+    end;
+browserVersion(VsnString) ->
+    browserVersion([$/|VsnString]).
+
+operativeSystem(OpString) ->
+  operativeSystem(OpString, ?OPERATIVE_SYSTEMS).
+
+operativeSystem(_OpString,[]) ->
+    unknown;
+operativeSystem(OpString,[{RetVal,RegExps}|Rest]) ->
+    case controlOperativeSystem(OpString,RegExps) of
+	true ->
+	    RetVal;
+	_ ->
+	    operativeSystem(OpString,Rest)
+    end.
+
+controlOperativeSystem(_OpString,[]) ->
+    false;
+controlOperativeSystem(OpString,[Regexp|Regexps]) ->
+    case regexp:match(OpString,Regexp) of
+	{match,_,_} ->
+	    true;
+	nomatch ->
+	    controlOperativeSystem(OpString,Regexps)
+    end.
+
+
+%% OK this is ugly but thats the only way since 
+%% all browsers dont conform to the name/vsn standard
+%% First we check if it is one of the browsers that 
+%% are not the default mozillaborwser against the regexp 
+%% for the different browsers. if no match, it is a mozilla 
+%% browser i.e opera, netscape, ie or safari
+
+getMozilla(_AgentString,[],Default) ->
+    Default;
+getMozilla(AgentString,[{Agent,AgentRegExp}|Rest],Default) ->
+    case regexp:match(AgentString,AgentRegExp) of
+	{match,_,_} ->
+	    {Agent,getMozVersion(AgentString,AgentRegExp)};
+	nomatch ->
+	    getMozilla(AgentString,Rest,Default)
+    end.
+
+getMozVersion(AgentString, AgentRegExp) ->
+    case regexp:match(AgentString,AgentRegExp++"[0-9\.\ \/]*") of
+	{match,Start,Length} when length(AgentRegExp) < Length ->
+	    %% Ok we got the number split it out
+	    RealStart  = Start+length(AgentRegExp),
+	    RealLength = Length-length(AgentRegExp),
+	    VsnString  = string:substr(AgentString,RealStart,RealLength),
+	    %% case string:strip(VsnString,both,$\ ) of
+	    case strip(VsnString) of
+		[] ->
+		    unknown;
+		[Y1,Y2,Y3,Y4,M1,M2,D1,D2] = DateVsn when
+		      Y1 =< $9, Y1 >= $0,
+		      Y2 =< $9, Y2 >= $0,
+		      Y3 =< $9, Y3 >= $0,
+		      Y4 =< $9, Y4 >= $0,
+		      M1 =< $9, M1 >= $0,
+		      M2 =< $9, M2 >= $0,
+		      D1 =< $9, D1 >= $0,
+		      D2 =< $9, D2 >= $0 ->
+		    list_to_integer(DateVsn);
+		Vsn ->
+		    case string:tokens(Vsn,".") of
+			[Number]->
+			    list_to_float(Number++".0");
+			[Major,Minor|Rev] ->
+			    V = lists:flatten([Major,".",Minor,Rev]),
+			    list_to_float(V)
+		    end
+	    end;
+	nomatch ->
+	    unknown
+    end.
+
+strip(VsnString) ->
+    strip2(strip1(VsnString)).
+
+strip1(VsnString) ->    
+    string:strip(VsnString,both,$\ ).
+
+strip2(VsnString) ->    
+    string:strip(VsnString,both,$/ ).
+
+test()->
+    test("Mozilla/4.75 [en] (X11; U; SunOS 5.8 sun4u)"),
+    test("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0"),
+    test("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.1) Gecko/20020827"),
+    test("Mozilla/5.0 (Macintosh; U; PPC Mac OS X Mach-O; en-US; rv:1.4) Gecko/20020827"),
+    test("Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85 (KHTML, like Gecko) Safari/85"),
+    test("Mozilla/4.0 (compatible; MSIE 5.0; SP1B; SunOS 5.8 sun4u; X11)"),
+    test("Lynx/2.8.3rel.1 libwww-FM/2.142"),
+    ok.
+
+test(Str) ->
+    Browser = getBrowser(Str),
+    io:format("~n--------------------------------------------------------~n"),
+    io:format("~p",[Browser]),
+    io:format("~n--------------------------------------------------------~n").
+

Added: incubator/couchdb/trunk/src/couch_inets/mod_cgi.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_cgi.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_cgi.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_cgi.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,331 @@
+%% ``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$
+%%
+%% Implements  The WWW Common Gateway Interface Version 1.1
+
+-module(mod_cgi).
+
+-export([env/3]).
+
+%%% Callback API
+-export([do/1, load/2]).
+
+-include("http_internal.hrl").
+-include("httpd.hrl").
+
+%% We will not make the change to use base64 in stdlib in inets just yet.
+%% it will be included in the next major release of inets. 
+-compile({nowarn_deprecated_function, {http_base_64, encode, 1}}).
+
+-define(VMODULE,"CGI").
+
+-define(DEFAULT_CGI_TIMEOUT, 15000).
+
+%%%=========================================================================
+%%%  API
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% do(ModData, _, AfterScript) ->  [{EnvVariable, Value}]
+%%                
+%%     AfterScript = string()
+%%     ModData = #mod{}
+%%     EnvVariable = string() 
+%%     Value = term()
+%% Description: Keep for now as it is documented in the man page
+%%-------------------------------------------------------------------------
+env(ModData, _Script, AfterScript) ->
+    ScriptElements = script_elements(ModData, AfterScript),
+    httpd_script_env:create_env(cgi, ModData, ScriptElements).
+
+%%%=========================================================================
+%%%  Callback API
+%%%=========================================================================
+
+%%--------------------------------------------------------------------------
+%% do(ModData) -> {proceed, OldData} | {proceed, NewData} | {break, NewData} 
+%%                | done
+%%     ModData = #mod{}
+%%
+%% Description:  See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+do(ModData) ->
+    case httpd_util:key1search(ModData#mod.data, status) of
+	%% A status code has been generated!
+	{_StatusCode, _PhraseArgs, _Reason} ->
+	    {proceed, ModData#mod.data};
+	%% No status code has been generated!
+	undefined ->
+	    case httpd_util:key1search(ModData#mod.data, response) of
+		undefined ->
+		    generate_response(ModData);
+		_Response ->
+		    {proceed, ModData#mod.data}
+	    end
+    end.
+
+%%--------------------------------------------------------------------------
+%% load(Line, Context) ->  eof | ok | {ok, NewContext} | 
+%%                     {ok, NewContext, Directive} | 
+%%                     {ok, NewContext, DirectiveList} | {error, Reason}
+%% Line = string()
+%% Context = NewContext = DirectiveList = [Directive]
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term() 
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+
+%% ScriptNoCache true|false, defines whether the server shall add     
+%%                           header fields to stop proxies and          
+%%                           clients from saving the page in history  
+%%                           or cache                                 
+%%                                                                             
+load("ScriptNoCache " ++ CacheArg, [])->
+    case catch list_to_atom(httpd_conf:clean(CacheArg)) of
+        true ->
+	    {ok, [], {script_nocache, true}};
+	false ->
+	   {ok, [], {script_nocache, false}};
+	_ ->
+	   {error, ?NICE(httpd_conf:clean(CacheArg)++
+			 " is an invalid ScriptNoCache directive")}
+    end;
+%% ScriptTimeout Seconds, The number of seconds that the server       
+%%                        maximum will wait for the script to         
+%%                        generate a part of the document   
+load("ScriptTimeout " ++ Timeout, [])->
+    case catch list_to_integer(httpd_conf:clean(Timeout)) of
+	TimeoutSec when integer(TimeoutSec)  ->
+	   {ok, [], {script_timeout,TimeoutSec*1000}};
+	_ ->
+	   {error, ?NICE(httpd_conf:clean(Timeout)++
+			 " is an invalid ScriptTimeout")}
+    end.
+	
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+generate_response(ModData) ->
+    RequestURI =
+	case httpd_util:key1search(ModData#mod.data, new_request_uri) of
+	    undefined ->
+		ModData#mod.request_uri;
+	    Value ->
+		Value
+	end,
+    ScriptAliases =
+	httpd_util:multi_lookup(ModData#mod.config_db, script_alias),
+    case mod_alias:real_script_name(ModData#mod.config_db, RequestURI,
+				    ScriptAliases) of
+	{Script, AfterScript} ->
+	    exec_script(ModData, Script, AfterScript, 
+			RequestURI);
+	not_a_script ->
+	    {proceed, ModData#mod.data}
+    end.
+
+is_executable(File) ->
+    Dir      = filename:dirname(File),
+    FileName = filename:basename(File),
+    case os:type() of
+	{win32,_} ->
+	    %% temporary (hopefully) fix for win32 OTP-3627
+	    is_win32_executable(Dir,FileName);
+	_ ->
+	    is_executable(Dir, FileName) 
+    end.
+
+is_executable(Dir, FilName) ->
+    case os:find_executable(FilName, Dir) of
+	false ->
+	    false;
+	_ ->
+	    true
+    end.
+
+%% Start temporary (hopefully) fix for win32 OTP-3627
+%% ---------------------------------
+is_win32_executable(Dir, FileName) ->
+    NewFileName = strip_extention(FileName, [".bat",".exe",".com", ".cmd"]),
+    is_executable(Dir, NewFileName).
+
+strip_extention(FileName, []) ->
+    FileName;
+strip_extention(FileName, [Extention | Extentions]) ->
+    case filename:basename(FileName, Extention) of
+	FileName ->
+	    strip_extention(FileName, Extentions); 
+	NewFileName ->
+	    NewFileName
+    end.
+
+%% End fix
+%% ---------------------------------
+
+exec_script(ModData, Script, AfterScript, RequestURI) ->
+    exec_script(is_executable(Script), ModData, Script, 
+		AfterScript, RequestURI).
+
+exec_script(true, ModData, Script, AfterScript, _RequestURI) ->
+    process_flag(trap_exit,true),
+    Dir  = filename:dirname(Script),
+    ScriptElements = script_elements(ModData, AfterScript),
+    Env = (catch httpd_script_env:create_env(cgi, ModData, ScriptElements)),
+
+    %% Run script
+    Port = (catch open_port({spawn, Script},[binary, stream,
+					     {cd, Dir}, {env, Env}])),
+    case Port of
+	Port when is_port(Port) ->
+	    send_request_body_to_script(ModData, Port),
+	    deliver_webpage(ModData, Port); % Take care of script output
+	Error ->
+	    exit({open_port_failed, Error,
+		  [{mod,?MODULE},
+		   {uri,ModData#mod.request_uri}, {script,Script},
+		   {env,Env},{dir,Dir}]})
+    end;
+
+exec_script(false, ModData, _Script, _AfterScript, _RequestURI) ->
+    {proceed,
+     [{status,
+       {404,ModData#mod.request_uri,
+	?NICE("You don't have permission to execute " ++
+	      ModData#mod.request_uri ++ " on this server")}}|
+      ModData#mod.data]}.
+    
+send_request_body_to_script(ModData, Port) ->
+    case ModData#mod.entity_body of
+	[] ->
+	    ok;
+	EntityBody ->
+	    port_command(Port, EntityBody)
+    end.	
+	   
+deliver_webpage(#mod{config_db = Db} = ModData, Port) ->
+    Timeout = cgi_timeout(Db),    
+    case receive_headers(Port, httpd_cgi, parse_headers, 
+			 [<<>>, [], []], Timeout) of
+	{Headers, Body} ->
+	    case httpd_cgi:handle_headers(Headers) of
+		{proceed, AbsPath} ->
+		    {proceed, [{real_name, 
+				httpd_util:split_path(AbsPath)} | 
+			       ModData#mod.data]};
+		{ok, HTTPHeaders, Status} ->
+		    IsDisableChunkedSend = 
+			httpd_response:is_disable_chunked_send(Db),
+		    case (ModData#mod.http_version =/= "HTTP/1.1") or 
+			(IsDisableChunkedSend) of
+			true ->
+			    send_headers(ModData, Status, 
+					 [{"connection", "close"}
+					   | HTTPHeaders]);
+			false ->
+			    send_headers(ModData, Status,
+					 [{"transfer-encoding",
+					   "chunked"} | HTTPHeaders])
+		    end,
+		    handle_body(Port, ModData, Body, Timeout, size(Body),
+				IsDisableChunkedSend)
+	    end;
+	{'EXIT', Port, Reason} ->
+	    process_flag(trap_exit, false),
+	    {proceed, [{status, {400, none, reason(Reason)}} |
+		       ModData#mod.data]};
+	timeout ->
+	    (catch port_close(Port)), % KILL the port !!!!
+	    send_headers(ModData, {504, "Timeout"}, []),
+	    httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket),
+	    process_flag(trap_exit,false),
+	    {proceed,[{response, {already_sent, 200, 0}} | ModData#mod.data]}
+    end.
+	    
+receive_headers(Port, Module, Function, Args, Timeout) ->
+      receive
+	  {Port, {data, Response}} when is_port(Port) ->
+	      case Module:Function([Response | Args]) of
+		  {NewModule, NewFunction, NewArgs} ->
+		      receive_headers(Port, NewModule, 
+				      NewFunction, NewArgs, Timeout);
+		  {ok, {Headers, Body}} ->
+		      {Headers, Body}
+	      end;
+	  {'EXIT', Port, Reason} when is_port(Port) ->
+	      {'EXIT', Port, Reason};
+	  {'EXIT', Pid, Reason} when is_pid(Pid) ->
+	      exit({linked_process_died, Pid, Reason})
+      after Timeout ->
+	      timeout
+      end.
+
+send_headers(ModData, {StatusCode, _}, HTTPHeaders) ->
+    ExtraHeaders = httpd_response:cache_headers(ModData),
+    httpd_response:send_header(ModData, StatusCode, 
+			       ExtraHeaders ++ HTTPHeaders).
+
+handle_body(Port, #mod{method = "HEAD"} = ModData, _, _, Size, _) ->
+    (catch port_close(Port)), % KILL the port !!!!
+    process_flag(trap_exit,false),
+    {proceed, [{response, {already_sent, 200, Size}} | ModData#mod.data]};
+
+handle_body(Port, ModData, Body, Timeout, Size, IsDisableChunkedSend) ->
+    httpd_response:send_chunk(ModData, Body, IsDisableChunkedSend),
+    receive 
+	{Port, {data, Data}} when port(Port) ->
+	    handle_body(Port, ModData, Data, Timeout, Size + size(Data),
+			IsDisableChunkedSend);
+	{'EXIT', Port, normal} when is_port(Port) ->
+	    httpd_response:send_final_chunk(ModData, IsDisableChunkedSend),
+	    process_flag(trap_exit,false),
+	    {proceed, [{response, {already_sent, 200, Size}} |
+		       ModData#mod.data]};
+	{'EXIT', Port, Reason} when is_port(Port) ->
+	    process_flag(trap_exit, false),
+	    {proceed, [{status, {400, none, reason(Reason)}} | 
+		       ModData#mod.data]};
+	{'EXIT', Pid, Reason} when is_pid(Pid) ->
+	    exit({mod_cgi_linked_process_died, Pid, Reason})
+    after Timeout ->
+	    (catch port_close(Port)), % KILL the port !!!!
+	    process_flag(trap_exit,false),
+	    {proceed,[{response, {already_sent, 200, Size}} |
+		      ModData#mod.data]}
+    end.
+
+script_elements(#mod{method = "GET"}, {[], QueryString}) ->
+    [{query_string, QueryString}];
+script_elements(#mod{method = "GET"}, {PathInfo, []}) ->
+    [{path_info, PathInfo}];
+script_elements(#mod{method = "GET"}, {PathInfo, QueryString}) ->
+    [{query_string, QueryString}, {path_info, PathInfo}];
+script_elements(#mod{method = "POST", entity_body = Body}, _) ->
+    [{entity_body, Body}];
+script_elements(_, _) ->
+    [].
+
+cgi_timeout(Db) ->
+    httpd_util:lookup(Db, cgi_timeout, ?DEFAULT_CGI_TIMEOUT).
+
+%% Convert error to printable string
+%%
+reason({error,emfile})     -> ": To many open files";
+reason({error,{enfile,_}}) -> ": File/port table overflow";
+reason({error,enomem})     -> ": Not enough memory";
+reason({error,eagain})     -> ": No more available OS processes";
+reason(Reason) -> lists:flatten(io_lib:format("Reason: ~p~n", [Reason])).

Added: incubator/couchdb/trunk/src/couch_inets/mod_dir.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_dir.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_dir.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_dir.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,281 @@
+%% ``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(mod_dir).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+    ?DEBUG("do -> entry",[]),
+    case Info#mod.method of
+	"GET" ->
+	    case httpd_util:key1search(Info#mod.data,status) of
+		%% A status code has been generated!
+		{_StatusCode, _PhraseArgs, _Reason} ->
+		    {proceed,Info#mod.data};
+		%% No status code has been generated!
+		undefined ->
+		    case httpd_util:key1search(Info#mod.data,response) of
+			%% No response has been generated!
+			undefined ->
+			    do_dir(Info);
+			%% A response has been generated or sent!
+			_Response ->
+			    {proceed,Info#mod.data}
+		    end
+	    end;
+	%% Not a GET method!
+	_ ->
+	    {proceed,Info#mod.data}
+    end.
+
+do_dir(Info) ->
+    ?DEBUG("do_dir -> Request URI: ~p",[Info#mod.request_uri]),
+    Path = mod_alias:path(Info#mod.data,Info#mod.config_db,
+			  Info#mod.request_uri),
+    DefaultPath = mod_alias:default_index(Info#mod.config_db,Path),
+    %% Is it a directory?
+    case file:read_file_info(DefaultPath) of
+	{ok,FileInfo} when FileInfo#file_info.type == directory ->
+	    DecodedRequestURI =
+		httpd_util:decode_hex(Info#mod.request_uri),
+	    ?DEBUG("do_dir -> ~n"
+		   "      Path:              ~p~n"
+		   "      DefaultPath:       ~p~n"
+		   "      DecodedRequestURI: ~p",
+		   [Path,DefaultPath,DecodedRequestURI]),
+	    case dir(DefaultPath,string:strip(DecodedRequestURI,right,$/),
+		     Info#mod.config_db) of
+		{ok, Dir} ->
+		    LastModified =
+			case (catch httpd_util:rfc1123_date(
+				      FileInfo#file_info.mtime)) of
+			    Date when is_list(Date) ->
+				[{"date", Date}];
+			    _ -> %% This will rarly happen, but could happen
+				%% if a computer is wrongly configured. 
+				[]
+			end,
+		    Head=[{content_type,"text/html"},
+			  {content_length,
+			   integer_to_list(httpd_util:flatlength(Dir))},
+			  {code,200} | LastModified],
+		    {proceed,[{response,{response, Head, Dir}},
+			      {mime_type,"text/html"} | Info#mod.data]};
+		{error, Reason} ->
+		    ?ERROR("do_dir -> dir operation failed: ~p",[Reason]),
+		    {proceed,
+		     [{status,{404,Info#mod.request_uri,Reason}}|
+		      Info#mod.data]}
+	    end;
+	{ok, _FileInfo} ->
+	    ?DEBUG("do_dir -> ~n"
+		   "      Path:        ~p~n"
+		   "      DefaultPath: ~p~n"
+		   "      FileInfo:    ~p",
+		   [Path,DefaultPath,FileInfo]),
+	    {proceed,Info#mod.data};
+	{error,Reason} ->
+	    ?LOG("do_dir -> failed reading file info (~p) for: ~p",
+		 [Reason,DefaultPath]),
+	    Status = httpd_file:handle_error(Reason, "access", Info,
+					     DefaultPath),
+	    {proceed, [{status, Status}| Info#mod.data]}
+    end.
+
+dir(Path,RequestURI,ConfigDB) ->
+    case file:list_dir(Path) of
+	{ok,FileList} ->
+	    SortedFileList=lists:sort(FileList),
+	    {ok,[header(Path,RequestURI),
+		 body(Path,RequestURI,ConfigDB,SortedFileList),
+		 footer(Path,SortedFileList)]};
+	{error,Reason} ->
+	    {error,?NICE("Can't open directory "++Path++": "++Reason)}
+    end.
+
+%% header
+
+header(Path,RequestURI) ->
+    Header = "<HTML>\n<HEAD>\n<TITLE>Index of "++ RequestURI ++
+	"</TITLE>\n</HEAD>\n<BODY>\n<H1>Index of "++
+	RequestURI ++ "</H1>\n<PRE><IMG SRC=\"" ++ icon(blank) ++
+	"\" ALT="     "> Name                   Last modified         "
+	"Size  Description <HR>\n",
+    case regexp:sub(RequestURI,"[^/]*\$","") of
+	{ok,"/",_} ->
+	    Header;
+	{ok,ParentRequestURI,_} ->
+	    {ok,ParentPath,_} =
+		regexp:sub(string:strip(Path,right,$/),"[^/]*\$",""),
+	    Header++format(ParentPath,ParentRequestURI)
+    end.
+
+format(Path,RequestURI) ->
+    {ok,FileInfo}=file:read_file_info(Path),
+    {{Year, Month, Day},{Hour, Minute, _Second}} = FileInfo#file_info.mtime,
+    io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\">"
+		  " <A HREF=\"~s\">Parent directory</A>      "
+		  " ~2.2.0w-~s-~w ~2.2.0w:~2.2.0w        -\n",
+		  [icon(back),"DIR",RequestURI,Day,
+		   httpd_util:month(Month),Year,Hour,Minute]).
+
+%% body
+
+body(_Path, _RequestURI, _ConfigDB, []) ->
+    [];
+body(Path, RequestURI, ConfigDB, [Entry | Rest]) ->
+    [format(Path, RequestURI, ConfigDB, Entry)|
+     body(Path, RequestURI, ConfigDB, Rest)].
+
+format(Path,RequestURI,ConfigDB,Entry) ->
+    case file:read_file_info(Path++"/"++Entry) of
+	{ok,FileInfo} when FileInfo#file_info.type == directory ->
+	    {{Year, Month, Day},{Hour, Minute, _Second}} = 
+		FileInfo#file_info.mtime,
+	    EntryLength=length(Entry),
+	    if
+		EntryLength > 21 ->
+		    io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> "
+				  "<A HREF=\"~s\">~-21.s..</A>"
+				  "~2.2.0w-~s-~w ~2.2.0w:~2.2.0w"
+				  "        -\n", [icon(folder),"DIR",
+						  RequestURI++"/"++Entry++"/",
+						  Entry,
+						  Day, httpd_util:month(Month),
+						  Year,Hour,Minute]);
+		true ->
+		    io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\">"
+				  " <A HREF=\"~s\">~s</A>~*.*c~2.2.0"
+				  "w-~s-~w ~2.2.0w:~2.2.0w        -\n",
+				  [icon(folder),"DIR",RequestURI ++ "/" ++
+				   Entry ++ "/",Entry,
+				   23-EntryLength,23-EntryLength,$ ,Day,
+				   httpd_util:month(Month),Year,Hour,Minute])
+	    end;
+	{ok,FileInfo} ->
+	    {{Year, Month, Day},{Hour, Minute,_Second}} =
+		FileInfo#file_info.mtime,
+	    Suffix=httpd_util:suffix(Entry),
+	    MimeType=httpd_util:lookup_mime(ConfigDB,Suffix,""),
+	    EntryLength=length(Entry),
+	    if
+		EntryLength > 21 ->
+		    io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\">"
+				  " <A HREF=\"~s\">~-21.s..</A>~2.2.0"
+				  "w-~s-~w ~2.2.0w:~2.2.0w~8wk  ~s\n",
+				  [icon(Suffix, MimeType), Suffix, RequestURI 
+				   ++"/"++Entry, Entry,Day,
+				   httpd_util:month(Month),Year,Hour,Minute,
+				   trunc(FileInfo#file_info.size/1024+1),
+				   MimeType]);
+		true ->
+		    io_lib:format("<IMG SRC=\"~s\" ALT=\"[~s]\"> "
+				  "<A HREF=\"~s\">~s</A>~*.*c~2.2.0w-~s-~w"
+				  " ~2.2.0w:~2.2.0w~8wk  ~s\n",
+				  [icon(Suffix, MimeType), Suffix, RequestURI
+				   ++ "/" ++ Entry, Entry, 23-EntryLength,
+				   23-EntryLength, $ ,Day,
+				   httpd_util:month(Month),Year,Hour,Minute,
+				   trunc(FileInfo#file_info.size/1024+1),
+				   MimeType])
+	    end;
+	{error, _Reason} ->
+	    ""
+    end.
+
+%% footer
+
+footer(Path,FileList) ->
+    case lists:member("README",FileList) of
+	true ->
+	    {ok,Body}=file:read_file(Path++"/README"),
+	    "</PRE>\n<HR>\n<PRE>\n"++binary_to_list(Body)++
+		"\n</PRE>\n</BODY>\n</HTML>\n";
+	false ->
+	    "</PRE>\n</BODY>\n</HTML>\n"
+    end.
+
+%%
+%% Icon mappings are hard-wired ala default Apache (Ugly!)
+%%
+
+icon(Suffix,MimeType) ->
+    case icon(Suffix) of
+	undefined ->
+	    case MimeType of
+		[$t,$e,$x,$t,$/|_] ->
+		    "/icons/text.gif";
+		[$i,$m,$a,$g,$e,$/|_] ->
+		    "/icons/image2.gif";
+		[$a,$u,$d,$i,$o,$/|_] ->
+		    "/icons/sound2.gif";
+		[$v,$i,$d,$e,$o,$/|_] ->
+		    "/icons/movie.gif";
+		_ ->
+		    "/icons/unknown.gif"
+	    end;
+	Icon ->
+	    Icon
+    end.
+
+icon(blank) -> "/icons/blank.gif";
+icon(back) -> "/icons/back.gif";
+icon(folder) -> "/icons/folder.gif";
+icon("bin") -> "/icons/binary.gif";
+icon("exe") -> "/icons/binary.gif";
+icon("hqx") -> "/icons/binhex.gif";
+icon("tar") -> "/icons/tar.gif";
+icon("wrl") -> "/icons/world2.gif";
+icon("wrl.gz") -> "/icons/world2.gif";
+icon("vrml") -> "/icons/world2.gif";
+icon("vrm") -> "/icons/world2.gif";
+icon("iv") -> "/icons/world2.gif";
+icon("Z") -> "/icons/compressed.gif";
+icon("z") -> "/icons/compressed.gif";
+icon("tgz") -> "/icons/compressed.gif";
+icon("gz") -> "/icons/compressed.gif";
+icon("zip") -> "/icons/compressed.gif";
+icon("ps") -> "/icons/a.gif";
+icon("ai") -> "/icons/a.gif";
+icon("eps") -> "/icons/a.gif";
+icon("html") -> "/icons/layout.gif";
+icon("shtml") -> "/icons/layout.gif";
+icon("htm") -> "/icons/layout.gif";
+icon("pdf") -> "/icons/layout.gif";
+icon("txt") -> "/icons/text.gif";
+icon("erl") -> "/icons/burst.gif";
+icon("c") -> "/icons/c.gif";
+icon("pl") -> "/icons/p.gif";
+icon("py") -> "/icons/p.gif";
+icon("for") -> "/icons/f.gif";
+icon("dvi") -> "/icons/dvi.gif";
+icon("uu") -> "/icons/uuencoded.gif";
+icon("conf") -> "/icons/script.gif";
+icon("sh") -> "/icons/script.gif";
+icon("shar") -> "/icons/script.gif";
+icon("csh") -> "/icons/script.gif";
+icon("ksh") -> "/icons/script.gif";
+icon("tcl") -> "/icons/script.gif";
+icon("tex") -> "/icons/tex.gif";
+icon("core") -> "/icons/tex.gif";
+icon(_) -> undefined.
+
+

Added: incubator/couchdb/trunk/src/couch_inets/mod_disk_log.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_disk_log.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_disk_log.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_disk_log.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$
+%%
+-module(mod_disk_log).
+-export([do/1,error_log/5,security_log/2,load/2,store/2,remove/1]).
+
+-export([report_error/2]).
+
+-define(VMODULE,"DISK_LOG").
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+    AuthUser  = auth_user(Info#mod.data),
+    Date      = custom_date(),
+    log_internal_info(Info,Date,Info#mod.data),
+    LogFormat = get_log_format(Info#mod.config_db),
+    case httpd_util:key1search(Info#mod.data,status) of
+	%% A status code has been generated!
+	{StatusCode, _PhraseArgs, Reason} ->
+	    transfer_log(Info, "-", AuthUser, Date, StatusCode, 0, LogFormat),
+	    if
+		StatusCode >= 400 ->
+		    error_log(Info, Date, Reason, LogFormat);
+		true ->
+		    not_an_error
+	    end,
+	    {proceed,Info#mod.data};
+	%% No status code has been generated!
+	undefined ->
+	    case httpd_util:key1search(Info#mod.data,response) of
+		{already_sent,StatusCode,Size} ->
+		    transfer_log(Info, "-", AuthUser, Date, StatusCode,
+				 Size, LogFormat),
+		    {proceed,Info#mod.data};
+
+		{response, Head, _Body} ->
+		    Size = httpd_util:key1search(Head, content_length, 0),
+		    Code = httpd_util:key1search(Head, code, 200),
+		    transfer_log(Info, "-", AuthUser, Date, Code, 
+				 Size, LogFormat),
+		    {proceed,Info#mod.data};	
+		
+		{_StatusCode, Response} ->
+		    transfer_log(Info, "-", AuthUser, Date, 200,
+				 httpd_util:flatlength(Response), LogFormat),
+		    {proceed,Info#mod.data};
+		undefined ->
+		    transfer_log(Info, "-", AuthUser, Date, 200,
+				 0, LogFormat),
+		    {proceed,Info#mod.data}
+	    end
+    end.
+
+custom_date() ->
+    LocalTime     = calendar:local_time(),
+    UniversalTime = calendar:universal_time(),
+    Minutes       = round(diff_in_minutes(LocalTime,UniversalTime)),
+    {{YYYY,MM,DD},{Hour,Min,Sec}} = LocalTime,
+    Date = 
+	io_lib:format("~.2.0w/~.3s/~.4w:~.2.0w:~.2.0w:~.2.0w ~c~.2.0w~.2.0w",
+		      [DD,httpd_util:month(MM),YYYY,Hour,Min,Sec,sign(Minutes),
+		       abs(Minutes) div 60,abs(Minutes) rem 60]),  
+    lists:flatten(Date).
+
+diff_in_minutes(L,U) ->
+    (calendar:datetime_to_gregorian_seconds(L) -
+     calendar:datetime_to_gregorian_seconds(U))/60.
+
+sign(Minutes) when Minutes > 0 ->
+    $+;
+sign(_Minutes) ->
+    $-.
+
+auth_user(Data) ->
+    case httpd_util:key1search(Data,remote_user) of
+	undefined ->
+	    "-";
+	RemoteUser ->
+	    RemoteUser
+    end.
+
+%% log_internal_info
+
+log_internal_info(_, _,[]) ->
+    ok;
+log_internal_info(Info,Date,[{internal_info,Reason}|Rest]) ->
+    Format = get_log_format(Info#mod.config_db),
+    error_log(Info,Date,Reason,Format),
+    log_internal_info(Info,Date,Rest);
+log_internal_info(Info,Date,[_|Rest]) ->
+    log_internal_info(Info,Date,Rest).
+
+
+%% transfer_log
+
+transfer_log(Info,RFC931,AuthUser,Date,StatusCode,Bytes,Format) ->
+    case httpd_util:lookup(Info#mod.config_db,transfer_disk_log) of
+	undefined ->
+	    no_transfer_log;
+	TransferDiskLog ->
+	    {_PortNumber, RemoteHost}=(Info#mod.init_data)#init_data.peername,
+	    Entry = io_lib:format("~s ~s ~s [~s] \"~s\" ~w ~w~n",
+				  [RemoteHost, RFC931, AuthUser, Date,
+				   Info#mod.request_line, StatusCode, Bytes]),
+	    write(TransferDiskLog, Entry, Format)
+    end.
+
+
+%% error_log
+
+error_log(Info, Date, Reason, Format) ->
+    Format=get_log_format(Info#mod.config_db),
+    case httpd_util:lookup(Info#mod.config_db,error_disk_log) of
+	undefined ->
+	    no_error_log;
+	ErrorDiskLog ->
+	    {_PortNumber, RemoteHost}=(Info#mod.init_data)#init_data.peername,
+	    Entry = 
+		io_lib:format("[~s] access to ~s failed for ~s, reason: ~p~n",
+			      [Date, Info#mod.request_uri, 
+			       RemoteHost, Reason]),
+	    write(ErrorDiskLog, Entry, Format)
+    end.
+
+error_log(_SocketType, _Socket, ConfigDB, {_PortNumber, RemoteHost}, Reason) ->
+    Format = get_log_format(ConfigDB),
+    case httpd_util:lookup(ConfigDB,error_disk_log) of
+	undefined ->
+	    no_error_log;
+	ErrorDiskLog ->
+	    Date  = custom_date(),
+	    Entry = 
+		io_lib:format("[~s] server crash for ~s, reason: ~p~n",
+			      [Date,RemoteHost,Reason]),
+	    write(ErrorDiskLog, Entry, Format),
+	    ok
+    end.
+
+
+%% security_log
+
+security_log(ConfigDB, Event) ->
+    Format = get_log_format(ConfigDB),
+    case httpd_util:lookup(ConfigDB,security_disk_log) of
+	undefined ->
+	    no_error_log;
+	DiskLog ->
+	    Date  = custom_date(),
+	    Entry = io_lib:format("[~s] ~s ~n", [Date, Event]),
+	    write(DiskLog, Entry, Format),
+	    ok
+    end.
+
+report_error(ConfigDB, Error) ->
+    Format = get_log_format(ConfigDB),
+    case httpd_util:lookup(ConfigDB, error_disk_log) of
+	undefined ->
+	    no_error_log;
+	ErrorDiskLog ->
+	    Date  = custom_date(),
+	    Entry = io_lib:format("[~s] reporting error: ~s",[Date,Error]),
+	    write(ErrorDiskLog, Entry, Format),
+	    ok
+    end.
+
+%%----------------------------------------------------------------------
+%% Get the current format of the disklog
+%%----------------------------------------------------------------------
+get_log_format(ConfigDB)->
+    httpd_util:lookup(ConfigDB,disk_log_format,external).
+
+
+%%
+%% Configuration
+%%
+
+%% load
+
+load([$T,$r,$a,$n,$s,$f,$e,$r,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ |
+      TransferDiskLogSize],[]) ->
+    case regexp:split(TransferDiskLogSize," ") of
+	{ok,[MaxBytes,MaxFiles]} ->
+	    case httpd_conf:make_integer(MaxBytes) of
+		{ok,MaxBytesInteger} ->
+		    case httpd_conf:make_integer(MaxFiles) of
+			{ok,MaxFilesInteger} ->
+			    {ok,[],{transfer_disk_log_size,
+				    {MaxBytesInteger,MaxFilesInteger}}};
+			{error,_} ->
+			    {error,
+			     ?NICE(httpd_conf:clean(TransferDiskLogSize)++
+				   " is an invalid TransferDiskLogSize")}
+		    end;
+		{error,_} ->
+		    {error,?NICE(httpd_conf:clean(TransferDiskLogSize)++
+				 " is an invalid TransferDiskLogSize")}
+	    end
+    end;
+load([$T,$r,$a,$n,$s,$f,$e,$r,$D,$i,$s,$k,$L,$o,$g,$ |TransferDiskLog],[]) ->
+    {ok,[],{transfer_disk_log,httpd_conf:clean(TransferDiskLog)}};
+
+load([$E,$r,$r,$o,$r,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ | ErrorDiskLogSize],[]) ->
+    case regexp:split(ErrorDiskLogSize," ") of
+	{ok,[MaxBytes,MaxFiles]} ->
+	    case httpd_conf:make_integer(MaxBytes) of
+		{ok,MaxBytesInteger} ->
+		    case httpd_conf:make_integer(MaxFiles) of
+			{ok,MaxFilesInteger} ->
+			    {ok,[],{error_disk_log_size,
+				    {MaxBytesInteger,MaxFilesInteger}}};
+			{error,_} ->
+			    {error,?NICE(httpd_conf:clean(ErrorDiskLogSize)++
+					 " is an invalid ErrorDiskLogSize")}
+		    end;
+		{error,_} ->
+		    {error,?NICE(httpd_conf:clean(ErrorDiskLogSize)++
+				 " is an invalid ErrorDiskLogSize")}
+	    end
+    end;
+load([$E,$r,$r,$o,$r,$D,$i,$s,$k,$L,$o,$g,$ |ErrorDiskLog],[]) ->
+    {ok, [], {error_disk_log, httpd_conf:clean(ErrorDiskLog)}};
+
+load([$S,$e,$c,$u,$r,$i,$t,$y,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ |SecurityDiskLogSize],[]) ->
+    case regexp:split(SecurityDiskLogSize, " ") of
+	{ok, [MaxBytes, MaxFiles]} ->
+	    case httpd_conf:make_integer(MaxBytes) of
+		{ok, MaxBytesInteger} ->
+		    case httpd_conf:make_integer(MaxFiles) of
+			{ok, MaxFilesInteger} ->
+			    {ok, [], {security_disk_log_size,
+				      {MaxBytesInteger, MaxFilesInteger}}};
+			{error,_} ->
+			    {error, ?NICE(httpd_conf:clean(SecurityDiskLogSize)++
+					  " is an invalid SecurityDiskLogSize")}
+		    end;
+		{error, _} ->
+		    {error, ?NICE(httpd_conf:clean(SecurityDiskLogSize)++
+				  " is an invalid SecurityDiskLogSize")}
+	    end
+    end;
+load([$S,$e,$c,$u,$r,$i,$t,$y,$D,$i,$s,$k,$L,$o,$g,$ |SecurityDiskLog],[]) ->
+    {ok, [], {security_disk_log, httpd_conf:clean(SecurityDiskLog)}};
+
+load([$D,$i,$s,$k,$L,$o,$g,$F,$o,$r,$m,$a,$t,$ |Format],[]) ->
+    case httpd_conf:clean(Format) of
+	"internal" ->
+	    {ok, [], {disk_log_format,internal}};
+	"external" ->
+	    {ok, [], {disk_log_format,external}};
+	_Default ->
+	    {ok, [], {disk_log_format,external}}
+    end.
+
+%% store
+
+store({transfer_disk_log,TransferDiskLog},ConfigList) ->
+    case create_disk_log(TransferDiskLog, transfer_disk_log_size, ConfigList) of
+	{ok,TransferDB} ->
+	    {ok,{transfer_disk_log,TransferDB}};
+	{error,Reason} ->
+	    {error,Reason}
+    end;
+store({security_disk_log,SecurityDiskLog},ConfigList) ->
+    case create_disk_log(SecurityDiskLog, security_disk_log_size, ConfigList) of
+	{ok,SecurityDB} ->
+	    {ok,{security_disk_log,SecurityDB}};
+	{error,Reason} ->
+	    {error,Reason}
+    end;
+store({error_disk_log,ErrorDiskLog},ConfigList) ->
+    case create_disk_log(ErrorDiskLog, error_disk_log_size, ConfigList) of
+	{ok,ErrorDB} ->
+	    {ok,{error_disk_log,ErrorDB}};
+	{error,Reason} ->
+	    {error,Reason}
+    end.
+
+
+%%----------------------------------------------------------------------
+%% Open or creates the disklogs 
+%%----------------------------------------------------------------------
+log_size(ConfigList, Tag) ->
+    httpd_util:key1search(ConfigList, Tag, {500*1024,8}).
+
+create_disk_log(LogFile, SizeTag, ConfigList) ->
+    Filename = httpd_conf:clean(LogFile),
+    {MaxBytes, MaxFiles} = log_size(ConfigList, SizeTag),
+    case filename:pathtype(Filename) of
+	absolute ->
+	    create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList);
+	volumerelative ->
+	    create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList);
+	relative ->
+	    case httpd_util:key1search(ConfigList,server_root) of
+		undefined ->
+		    {error,
+		     ?NICE(Filename++
+			   " is an invalid ErrorLog beacuse ServerRoot is not defined")};
+		ServerRoot ->
+		    AbsoluteFilename = filename:join(ServerRoot,Filename),
+		    create_disk_log(AbsoluteFilename, MaxBytes, MaxFiles,
+				     ConfigList)
+	    end
+    end.
+
+create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList) ->
+    Format = httpd_util:key1search(ConfigList, disk_log_format, external),
+    open(Filename, MaxBytes, MaxFiles, Format).
+    
+
+
+%% remove
+remove(ConfigDB) ->
+    lists:foreach(fun([DiskLog]) -> close(DiskLog) end,
+		  ets:match(ConfigDB,{transfer_disk_log,'$1'})),
+    lists:foreach(fun([DiskLog]) -> close(DiskLog) end,
+		  ets:match(ConfigDB,{error_disk_log,'$1'})),
+    ok.
+
+
+%% 
+%% Some disk_log wrapper functions:
+%% 
+
+%%----------------------------------------------------------------------
+%% Function:    open/4
+%% Description: Open a disk log file.
+%% Control which format the disk log will be in. The external file 
+%% format is used as default since that format was used by older 
+%% implementations of inets.
+%%
+%% When the internal disk log format is used, we will do some extra 
+%% controls. If the files are valid, try to repair them and if 
+%% thats not possible, truncate.
+%%----------------------------------------------------------------------
+
+open(Filename, MaxBytes, MaxFiles, internal) ->
+    Opts = [{format, internal}, {repair, truncate}],
+    open1(Filename, MaxBytes, MaxFiles, Opts);
+open(Filename, MaxBytes, MaxFiles, _) ->
+    Opts = [{format, external}],
+    open1(Filename, MaxBytes, MaxFiles, Opts).
+
+open1(Filename, MaxBytes, MaxFiles, Opts0) ->
+    Opts1 = [{name, Filename}, {file, Filename}, {type, wrap}] ++ Opts0,
+    case open2(Opts1, {MaxBytes, MaxFiles}) of
+        {ok, LogDB} ->
+            {ok, LogDB};
+        {error, Reason} ->
+            {error, 
+             ?NICE("Can't create " ++ Filename ++ 
+                   lists:flatten(io_lib:format(", ~p",[Reason])))};
+        _ ->
+            {error, ?NICE("Can't create "++Filename)}
+    end.
+
+open2(Opts, Size) ->
+    case disk_log:open(Opts) of
+        {error, {badarg, size}} ->
+            %% File did not exist, add the size option and try again
+            disk_log:open([{size, Size} | Opts]);
+        Else ->
+            Else
+    end.
+
+
+%%----------------------------------------------------------------------
+%% Actually writes the entry to the disk_log. If the log is an 
+%% internal disk_log write it with log otherwise with blog.
+%%----------------------------------------------------------------------  
+write(Log, Entry, internal) ->
+    disk_log:log(Log, Entry);
+
+write(Log, Entry, _) ->
+    disk_log:blog(Log, Entry).
+
+%% Close the log file
+close(Log) ->
+    disk_log:close(Log).

Added: incubator/couchdb/trunk/src/couch_inets/mod_esi.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_esi.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_esi.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_esi.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,432 @@
+%% ``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(mod_esi).
+
+%% API
+%% Functions provided to help erl scheme alias programmer to 
+%% Create dynamic webpages that are sent back to the user during 
+%% Generation
+-export([deliver/2]).
+
+%% Callback API
+-export([do/1, load/2]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"ESI").
+-define(DEFAULT_ERL_TIMEOUT,15000).
+
+%%%=========================================================================
+%%%  API 
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% deliver(SessionID, Data) -> ok | {error, bad_sessionID}
+%%	SessionID = pid()
+%%	Data = string() | io_list() (first call must send a string that 
+%%	contains all header information including "\r\n\r\n", unless there
+%%	is no header information at all.)
+%%
+%% Description: Send <Data> (Html page generated sofar) to the server
+%% request handling process so it can forward it to the client.
+%%-------------------------------------------------------------------------
+deliver(SessionID, Data) when pid(SessionID) ->
+    SessionID ! {ok, Data},
+    ok;
+deliver(_SessionID, _Data) ->
+    {error, bad_sessionID}.
+
+%%%=========================================================================
+%%%  CALLBACK API 
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% do(ModData) -> {proceed, OldData} | {proceed, NewData} | {break, NewData} 
+%%                | done
+%%     ModData = #mod{}
+%%
+%% Description:  See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+do(ModData) ->
+    case httpd_util:key1search(ModData#mod.data, status) of
+	{_StatusCode, _PhraseArgs, _Reason} ->
+	    {proceed, ModData#mod.data};
+	undefined ->
+	    case httpd_util:key1search(ModData#mod.data, response) of
+		undefined ->
+		    generate_response(ModData);
+		_Response ->
+		    {proceed, ModData#mod.data}
+	    end
+    end.
+%%--------------------------------------------------------------------------
+%% load(Line, Context) ->  eof | ok | {ok, NewContext} | 
+%%                     {ok, NewContext, Directive} | 
+%%                     {ok, NewContext, DirectiveList} | {error, Reason}
+%% Line = string()
+%% Context = NewContext = DirectiveList = [Directive]
+%% Directive = {DirectiveKey , DirectiveValue}
+%% DirectiveKey = DirectiveValue = term()
+%% Reason = term() 
+%%
+%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
+%%-------------------------------------------------------------------------
+load("ErlScriptAlias " ++ ErlScriptAlias, []) ->
+    case regexp:split(ErlScriptAlias," ") of
+	{ok, [ErlName | Modules]} ->
+	    {ok, [], {erl_script_alias, {ErlName,Modules}}};
+	{ok, _} ->
+	    {error, ?NICE(httpd_conf:clean(ErlScriptAlias) ++
+			 " is an invalid ErlScriptAlias")}
+    end;
+load("EvalScriptAlias " ++ EvalScriptAlias, []) ->
+    case regexp:split(EvalScriptAlias, " ") of
+	{ok, [EvalName|Modules]} ->
+	    {ok, [], {eval_script_alias, {EvalName, Modules}}};
+	{ok, _} ->
+	    {error, ?NICE(httpd_conf:clean(EvalScriptAlias) ++
+			  " is an invalid EvalScriptAlias")}
+    end;
+load("ErlScriptTimeout " ++ Timeout, [])->
+    case catch list_to_integer(httpd_conf:clean(Timeout)) of
+	TimeoutSec when integer(TimeoutSec)  ->
+	   {ok, [], {erl_script_timeout, TimeoutSec * 1000}};
+	_ ->
+	   {error, ?NICE(httpd_conf:clean(Timeout) ++
+			 " is an invalid ErlScriptTimeout")}
+    end;
+load("ErlScriptNoCache " ++ CacheArg, [])->
+    case catch list_to_atom(httpd_conf:clean(CacheArg)) of
+        true ->
+	    {ok, [], {erl_script_nocache, true}};
+	false ->
+	   {ok, [], {erl_script_nocache, false}};
+	_ ->
+	   {error, ?NICE(httpd_conf:clean(CacheArg)++
+			 " is an invalid ErlScriptNoCache directive")}
+    end.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================   
+generate_response(ModData) ->
+    case scheme(ModData#mod.request_uri, ModData#mod.config_db) of
+	{eval, ESIBody, Modules} ->
+	    eval(ModData, ESIBody, Modules);
+	{erl, ESIBody, Modules} ->
+	    erl(ModData, ESIBody, Modules);
+	no_scheme ->
+	    {proceed, ModData#mod.data}
+    end.
+
+scheme(RequestURI, ConfigDB) ->
+    case match_script(RequestURI, ConfigDB, erl_script_alias) of
+	no_match ->
+	    case match_script(RequestURI, ConfigDB, eval_script_alias) of
+		no_match ->
+		    no_scheme;
+		{EsiBody, ScriptModules} ->
+		    {eval, EsiBody, ScriptModules}
+	    end;
+	{EsiBody, ScriptModules} ->
+	    {erl, EsiBody, ScriptModules}
+    end.
+
+match_script(RequestURI, ConfigDB, AliasType) ->
+    case httpd_util:multi_lookup(ConfigDB, AliasType) of
+	[] ->
+	    no_match;
+	AliasAndMods ->
+	    match_esi_script(RequestURI, AliasAndMods, AliasType)
+    end.
+
+match_esi_script(_, [], _) ->
+    no_match;
+match_esi_script(RequestURI, [{Alias,Modules} | Rest], AliasType) ->
+    AliasMatchStr = alias_match_str(Alias, AliasType),
+    case regexp:first_match(RequestURI, AliasMatchStr) of
+	{match, 1, Length} ->
+	    {string:substr(RequestURI, Length + 1), Modules};
+	nomatch ->
+	    match_esi_script(RequestURI, Rest, AliasType)
+    end.
+
+alias_match_str(Alias, erl_script_alias) ->
+    "^" ++ Alias ++ "/";
+alias_match_str(Alias, eval_script_alias) ->
+    "^" ++ Alias ++ "\\?".
+
+
+%%------------------------ Erl mechanism --------------------------------
+
+erl(#mod{method = Method} = ModData, ESIBody, Modules) 
+  when Method == "GET"; Method == "HEAD"->
+    case httpd_util:split(ESIBody,":|%3A|/",2) of
+	{ok, [Module, FuncAndInput]} ->
+	    case httpd_util:split(FuncAndInput,"[\?/]",2) of
+		{ok, [FunctionName, Input]} ->
+		    generate_webpage(ModData, ESIBody, Modules, 
+				     Module, FunctionName, Input, 
+				    script_elements(FunctionName, Input));
+		{ok, [FunctionName]} ->
+		    generate_webpage(ModData, ESIBody, Modules, 
+				     Module, FunctionName, "", 
+				     script_elements(FunctionName, ""));
+		{ok, BadRequest} ->
+		    {proceed,[{status,{400,none, BadRequest}} | 
+			      ModData#mod.data]}
+	    end;
+	{ok, BadRequest} ->
+	    {proceed, [{status,{400, none, BadRequest}} | ModData#mod.data]}
+    end;
+
+erl(#mod{method = "POST", entity_body = Body} = ModData, ESIBody, Modules) ->
+    case httpd_util:split(ESIBody,":|%3A|/",2) of
+	{ok,[Module, Function]} ->
+	    generate_webpage(ModData, ESIBody, Modules, Module, 
+			     Function, Body, [{entity_body, Body}]);
+	{ok, BadRequest} ->
+	    {proceed,[{status, {400, none, BadRequest}} | ModData#mod.data]}
+    end.
+
+generate_webpage(ModData, ESIBody, ["all"], ModuleName, FunctionName,
+		 Input, ScriptElements) ->
+    generate_webpage(ModData, ESIBody, [ModuleName], ModuleName,
+		     FunctionName, Input, ScriptElements);
+generate_webpage(ModData, ESIBody, Modules, ModuleName, FunctionName,
+		 Input, ScriptElements) ->
+    case lists:member(ModuleName, Modules) of
+	true ->
+	    Env = httpd_script_env:create_env(esi, ModData, ScriptElements),
+	    Module = list_to_atom(ModuleName),
+	    Function = list_to_atom(FunctionName),
+	    case erl_scheme_webpage_chunk(Module, Function, 
+					  Env, Input, ModData) of
+		{error, erl_scheme_webpage_chunk_undefined} ->
+		    erl_scheme_webpage_whole(Module, Function, Env, Input,
+					     ModData);
+		ResponseResult ->
+		    ResponseResult
+	    end;
+	false ->
+	    {proceed, [{status, {403, ModData#mod.request_uri,
+				 ?NICE("Client not authorized to evaluate: "
+				       ++  ESIBody)}} | ModData#mod.data]}
+    end.
+
+%% Old API that waits for the dymnamic webpage to be totally generated
+%% before anythig is sent back to the client.
+erl_scheme_webpage_whole(Module, Function, Env, Input, ModData) ->
+    case (catch Module:Function(Env, Input)) of
+	{'EXIT',Reason} ->
+	    {proceed, [{status, {500, none, Reason}} |
+		       ModData#mod.data]};
+	Response ->
+	    {Headers, Body} = 
+		httpd_esi:parse_headers(lists:flatten(Response)),
+	    Length =  httpd_util:flatlength(Body),
+	    case httpd_esi:handle_headers(Headers) of
+		{proceed, AbsPath} ->
+		    {proceed, [{real_name, httpd_util:split_path(AbsPath)} 
+			       | ModData#mod.data]};
+		{ok, NewHeaders, StatusCode} ->
+		    send_headers(ModData, StatusCode, 
+				 [{"content-length", 
+				   integer_to_list(Length)}| NewHeaders]),
+		    case ModData#mod.method of
+			"HEAD" ->
+			    {proceed, [{response, {already_sent, 200, 0}} | 
+				       ModData#mod.data]};
+			_ ->
+			    httpd_response:send_body(ModData, 
+						     StatusCode, Body),
+			    {proceed, [{response, {already_sent, 200, 
+						  Length}} | 
+				       ModData#mod.data]}
+		    end
+	    end
+    end.
+
+%% New API that allows the dynamic wepage to be sent back to the client 
+%% in small chunks at the time during generation.
+erl_scheme_webpage_chunk(Mod, Func, Env, Input, ModData) -> 
+    process_flag(trap_exit, true),
+    Self = self(),
+    %% Spawn worker that generates the webpage.
+    %% It would be nicer to use erlang:function_exported/3 but if the 
+    %% Module isn't loaded the function says that it is not loaded
+    Pid = spawn_link(
+	    fun() ->
+		    case catch Mod:Func(Self, Env, Input) of
+			{'EXIT',{undef,_}} ->
+			    %% Will force fallback on the old API
+			    exit(erl_scheme_webpage_chunk_undefined);
+			_ ->
+			    ok  
+		    end
+	    end),
+ 
+    Response = deliver_webpage_chunk(ModData, Pid), 
+  
+    process_flag(trap_exit,false),
+    Response.
+
+deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid) ->
+    Timeout = erl_script_timeout(Db),
+    deliver_webpage_chunk(ModData, Pid, Timeout).
+
+deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) ->
+    case receive_headers(Timeout) of
+	{error, Reason} ->
+	    %% Happens when webpage generator callback/3 is undefined
+	    {error, Reason}; 
+	{Headers, Body} ->
+	    case httpd_esi:handle_headers(Headers) of
+		{proceed, AbsPath} ->
+		    {proceed, [{real_name, httpd_util:split_path(AbsPath)} 
+			       | ModData#mod.data]};
+		{ok, NewHeaders, StatusCode} ->
+		    IsDisableChunkedSend = 
+			httpd_response:is_disable_chunked_send(Db),
+		    case (ModData#mod.http_version =/= "HTTP/1.1") or
+			(IsDisableChunkedSend) of
+			true ->
+			    send_headers(ModData, StatusCode, 
+					 [{"connection", "close"} | 
+					  NewHeaders]);
+			false ->
+			    send_headers(ModData, StatusCode, 
+					 [{"transfer-encoding", 
+					   "chunked"} | NewHeaders])
+		    end,    
+		    handle_body(Pid, ModData, Body, Timeout, length(Body), 
+				IsDisableChunkedSend)
+	    end;
+	timeout ->
+	    send_headers(ModData, {504, "Timeout"},[{"connection", "close"}]),
+	    httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket),
+	    process_flag(trap_exit,false),
+	    {proceed,[{response, {already_sent, 200, 0}} | ModData#mod.data]}
+    end.
+
+receive_headers(Timeout) ->
+    receive
+	{ok, Chunk} ->
+	    httpd_esi:parse_headers(lists:flatten(Chunk));		
+	{'EXIT', Pid, erl_scheme_webpage_chunk_undefined} when is_pid(Pid) ->
+	    {error, erl_scheme_webpage_chunk_undefined};
+	{'EXIT', Pid, Reason} when is_pid(Pid) ->
+	    exit({mod_esi_linked_process_died, Pid, Reason})
+    after Timeout ->
+	    timeout
+    end.
+
+send_headers(ModData, StatusCode, HTTPHeaders) ->
+    ExtraHeaders = httpd_response:cache_headers(ModData),
+    httpd_response:send_header(ModData, StatusCode, 
+			       ExtraHeaders ++ HTTPHeaders).
+
+handle_body(_, #mod{method = "HEAD"} = ModData, _, _, Size, _) ->
+    process_flag(trap_exit,false),
+    {proceed, [{response, {already_sent, 200, Size}} | ModData#mod.data]};
+
+handle_body(Pid, ModData, Body, Timeout, Size, IsDisableChunkedSend) ->
+    httpd_response:send_chunk(ModData, Body, IsDisableChunkedSend),
+    receive 
+	{ok, Data} ->
+	    handle_body(Pid, ModData, Data, Timeout, Size + length(Data),
+			IsDisableChunkedSend);
+	{'EXIT', Pid, normal} when is_pid(Pid) ->
+	    httpd_response:send_final_chunk(ModData, IsDisableChunkedSend),
+	    {proceed, [{response, {already_sent, 200, Size}} | 
+		       ModData#mod.data]};
+	{'EXIT', Pid, Reason} when is_pid(Pid) ->
+	    exit({mod_esi_linked_process_died, Pid, Reason})
+    after Timeout ->
+	    process_flag(trap_exit,false),
+	    {proceed,[{response, {already_sent, 200, Size}} | 
+		      ModData#mod.data]}  
+    end.
+
+erl_script_timeout(Db) ->
+    httpd_util:lookup(Db, erl_script_timeout, ?DEFAULT_ERL_TIMEOUT).
+
+script_elements(FuncAndInput, Input) ->
+    case input_type(FuncAndInput) of
+        path_info ->
+	    [{path_info, Input}];
+	query_string ->
+	    [{query_string, Input}];
+	_ ->
+	    []
+    end.
+
+input_type([]) ->
+    no_input;
+input_type([$/|_Rest]) ->
+    path_info;
+input_type([$?|_Rest]) ->
+    query_string;
+input_type([_First|Rest]) ->
+    input_type(Rest).
+
+%%------------------------ Eval mechanism --------------------------------
+
+eval(#mod{request_uri = ReqUri, method = "POST",
+	  http_version = Version, data = Data}, _ESIBody, _Modules) ->
+    {proceed,[{status,{501,{"POST", ReqUri, Version},
+		       ?NICE("Eval mechanism doesn't support method POST")}}|
+	      Data]};
+
+eval(#mod{method = Method} = ModData, ESIBody, Modules) 
+  when Method == "GET"; Method == "HEAD" ->
+    case is_authorized(ESIBody, Modules) of
+	true ->
+	    case generate_webpage(ESIBody) of
+		{error, Reason} ->
+		    {proceed, [{status, {500, none, Reason}} | 
+			       ModData#mod.data]};
+		{ok, Response} ->
+		    {Headers, _} = 
+			httpd_esi:parse_headers(lists:flatten(Response)),
+		    case httpd_esi:handle_headers(Headers) of
+			{ok, _, StatusCode} ->
+			    {proceed,[{response, {StatusCode, Response}} | 
+				      ModData#mod.data]};
+			{proceed, AbsPath} ->
+			    {proceed, [{real_name, AbsPath} | 
+				       ModData#mod.data]}
+		    end
+	    end;
+	false ->
+	    {proceed,[{status,
+		       {403, ModData#mod.request_uri,
+			?NICE("Client not authorized to evaluate: "
+			      ++ ESIBody)}} | ModData#mod.data]}
+    end.
+
+generate_webpage(ESIBody) ->
+    (catch lib:eval_str(string:concat(ESIBody,". "))).
+
+is_authorized(_ESIBody, ["all"]) ->
+    true;
+is_authorized(ESIBody, Modules) ->
+    case regexp:match(ESIBody, "^[^\:(%3A)]*") of
+	{match, Start, Length} ->
+	    lists:member(string:substr(ESIBody, Start, Length), Modules);
+	nomatch ->
+	    false
+    end.

Added: incubator/couchdb/trunk/src/couch_inets/mod_get.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_get.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_get.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_get.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,125 @@
+%% ``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(mod_get).
+-export([do/1]).
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+    ?DEBUG("do -> entry",[]),
+    case Info#mod.method of
+	"GET" ->
+	    case httpd_util:key1search(Info#mod.data,status) of
+		%% A status code has been generated!
+		{_StatusCode, _PhraseArgs, _Reason} ->
+		    {proceed,Info#mod.data};
+		%% No status code has been generated!
+		undefined ->
+		    case httpd_util:key1search(Info#mod.data,response) of
+			%% No response has been generated!
+			undefined ->
+			    do_get(Info);
+			%% A response has been generated or sent!
+			_Response ->
+			    {proceed,Info#mod.data}
+		    end
+	    end;
+	%% Not a GET method!
+	_ ->
+	    {proceed,Info#mod.data}
+    end.
+
+
+do_get(Info) ->
+    ?DEBUG("do_get -> Request URI: ~p",[Info#mod.request_uri]),
+    Path = mod_alias:path(Info#mod.data, Info#mod.config_db, 
+			  Info#mod.request_uri),
+    {FileInfo, LastModified} = get_modification_date(Path),
+
+    send_response(Info#mod.socket,Info#mod.socket_type, Path, Info, 
+		  FileInfo, LastModified).
+
+
+%% The common case when no range is specified
+send_response(_Socket, _SocketType, Path, Info, FileInfo, LastModified)->
+    %% Send the file!
+    %% Find the modification date of the file
+    case file:open(Path,[raw,binary]) of
+	{ok, FileDescriptor} ->
+	    ?DEBUG("do_get -> FileDescriptor: ~p",[FileDescriptor]),
+	    Suffix = httpd_util:suffix(Path),
+	    MimeType = httpd_util:lookup_mime_default(Info#mod.config_db,
+						      Suffix,"text/plain"),
+	    %% FileInfo = file:read_file_info(Path),
+	    Size = integer_to_list(FileInfo#file_info.size),
+	    Headers = case Info#mod.http_version of
+			 "HTTP/1.1" ->
+			      [{content_type, MimeType},
+			       {etag, httpd_util:create_etag(FileInfo)},
+			       {content_length, Size}|LastModified];
+			  %% OTP-4935
+			 _ ->
+			     %% i.e http/1.0 and http/0.9
+			      [{content_type, MimeType},
+			       {content_length, Size}|LastModified]
+			  end,
+	    send(Info, 200, Headers, FileDescriptor),
+	    file:close(FileDescriptor),
+	    {proceed,[{response,{already_sent,200,
+				 FileInfo#file_info.size}},
+		      {mime_type,MimeType}|Info#mod.data]};
+	{error, Reason} ->
+	    Status = httpd_file:handle_error(Reason, "open", Info, Path),
+	    {proceed,
+	     [{status, Status}| Info#mod.data]}
+    end.
+
+%% send
+
+send(#mod{socket = Socket, socket_type = SocketType} = Info,
+     StatusCode, Headers, FileDescriptor) ->
+    ?DEBUG("send -> send header",[]),
+    httpd_response:send_header(Info, StatusCode, Headers),
+    send_body(SocketType,Socket,FileDescriptor).
+
+
+send_body(SocketType,Socket,FileDescriptor) ->
+    case file:read(FileDescriptor,?FILE_CHUNK_SIZE) of
+	{ok,Binary} ->
+	    ?DEBUG("send_body -> send another chunk: ~p",[size(Binary)]),
+	    case httpd_socket:deliver(SocketType,Socket,Binary) of
+		socket_closed ->
+		    ?LOG("send_body -> socket closed while sending",[]),
+		    socket_close;
+		_ ->
+		    send_body(SocketType,Socket,FileDescriptor)
+	    end;
+	eof ->
+	    ?DEBUG("send_body -> done with this file",[]),
+	    eof
+    end.
+
+get_modification_date(Path)->
+    {ok, FileInfo0} = file:read_file_info(Path), 
+    LastModified = 
+	case catch httpd_util:rfc1123_date(FileInfo0#file_info.mtime) of
+	    Date when is_list(Date) -> [{last_modified, Date}];
+	    _ -> []
+	end,
+    {FileInfo0, LastModified}.

Added: incubator/couchdb/trunk/src/couch_inets/mod_head.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_head.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_head.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_head.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,73 @@
+%% ``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(mod_head).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"HEAD").
+
+%% do
+
+do(Info) ->
+    case Info#mod.method of
+	"HEAD" ->
+	    case httpd_util:key1search(Info#mod.data,status) of
+		%% A status code has been generated!
+		{_StatusCode, _PhraseArgs, _Reason} ->
+		    {proceed,Info#mod.data};
+		%% No status code has been generated!
+		_undefined ->
+		    case httpd_util:key1search(Info#mod.data,response) of
+			%% No response has been generated!
+			undefined ->
+			    do_head(Info);
+			%% A response has been sent! Nothing to do about it!
+			{already_sent, _StatusCode, _Size} ->
+			    {proceed,Info#mod.data};
+			%% A response has been generated!
+			{_StatusCode, _Response} ->
+			    {proceed,Info#mod.data}
+		    end
+	    end;
+	%% Not a HEAD method!
+	_ ->
+	    {proceed,Info#mod.data}
+    end.
+
+do_head(Info) -> 
+    Path = mod_alias:path(Info#mod.data,
+			  Info#mod.config_db,
+			  Info#mod.request_uri),
+    Suffix = httpd_util:suffix(Path),
+    %% Does the file exists?
+    case file:read_file_info(Path) of
+	{ok, FileInfo} ->
+	    MimeType = 
+		httpd_util:lookup_mime_default(Info#mod.config_db,
+					       Suffix,"text/plain"),
+	    Length = io_lib:write(FileInfo#file_info.size),
+	    Head = 
+		[{content_type, MimeType},
+		 {content_length, Length}, {code,200}],
+	    {proceed,[{response, {response, Head,  nobody}} | Info#mod.data]};
+	{error, Reason} ->
+	    Status = httpd_file:handle_error(Reason, "access", Info, Path),
+	    {proceed,
+	     [{status, Status} | Info#mod.data]}
+    end.