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.
|