couchdb-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From cml...@apache.org
Subject svn commit: r642432 [12/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 GMT
Added: incubator/couchdb/trunk/src/couch_inets/mod_responsecontrol.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_responsecontrol.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_responsecontrol.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_responsecontrol.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,301 @@
+%% ``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_responsecontrol).
+-export([do/1]).
+
+-include("httpd.hrl").
+
+do(Info) ->
+    ?DEBUG("do -> response_control",[]),
+    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 ->
+		    case do_responsecontrol(Info) of
+			continue ->
+			    {proceed, Info#mod.data};
+			Response ->
+			    {proceed,[Response | Info#mod.data]}
+		    end;
+		%% A response has been generated or sent!
+		_Response ->
+ 		    {proceed, Info#mod.data}
+	    end
+    end.
+
+%%----------------------------------------------------------------------
+%%Control that the request header did not contians any limitations 
+%%wheather a response shall be createed or not
+%%----------------------------------------------------------------------
+do_responsecontrol(Info) ->
+    ?DEBUG("do_response_control -> Request URI: ~p",[Info#mod.request_uri]),
+    Path = mod_alias:path(Info#mod.data, Info#mod.config_db, 
+			  Info#mod.request_uri),
+    case file:read_file_info(Path) of
+	{ok, FileInfo} ->
+	    control(Path, Info, FileInfo);
+	_ ->
+	    %% The requested asset is not a plain file and then it must 
+	    %% be generated everytime its requested
+	    continue
+    end.
+
+%%----------------------------------------------------------------------
+%%Control the If-Match, If-None-Match,  and If-Modified-Since    
+%%----------------------------------------------------------------------
+
+
+%% If a client sends more then one of the if-XXXX fields in a request
+%% The standard says it does not specify the behaviuor so I specified it :-)
+%% The priority between the fields is 
+%% 1.If-modified
+%% 2.If-Unmodified
+%% 3.If-Match
+%% 4.If-Nomatch
+
+%% This means if more than one of the fields are in the request the 
+%% field with highest priority will be used
+
+%%If the request is a range request the If-Range field will be the winner.
+
+control(Path, Info, FileInfo) ->
+    case control_range(Path, Info, FileInfo) of
+	undefined ->
+	    case control_Etag(Path, Info, FileInfo) of
+		undefined ->
+		    case control_modification(Path, Info, FileInfo) of
+			continue ->
+			    continue;
+			ReturnValue ->
+			    send_return_value(ReturnValue, FileInfo)
+		    end;
+		continue ->
+		    continue;
+		ReturnValue ->
+		    send_return_value(ReturnValue, FileInfo)
+	    end;
+	Response->
+	    Response
+    end.
+
+%%----------------------------------------------------------------------
+%%If there are both a range and an if-range field control if
+%%----------------------------------------------------------------------
+control_range(Path,Info,FileInfo) ->
+    case httpd_util:key1search(Info#mod.parsed_header, "range") of
+	undefined->
+	    undefined;
+	_Range ->
+	    case httpd_util:key1search(Info#mod.parsed_header,"if-range") of
+		undefined ->
+		    undefined;
+		EtagOrDate ->
+		    control_if_range(Path,Info,FileInfo,EtagOrDate)
+	    end
+    end.
+
+control_if_range(_Path, Info, FileInfo, EtagOrDate) ->
+    case httpd_util:convert_request_date(strip_date(EtagOrDate)) of
+	bad_date ->
+	    FileEtag=httpd_util:create_etag(FileInfo),
+	    case FileEtag of
+		EtagOrDate ->
+		    continue;
+		_ ->
+		    {if_range,send_file}
+	    end;
+	_ErlDate ->    
+	    %%We got the date in the request if it is 
+	    case control_modification_data(Info, FileInfo#file_info.mtime,
+					   "if-range") of
+		modified ->
+		    {if_range,send_file};
+		_UnmodifiedOrUndefined->
+		    continue
+	    end
+    end.
+		 
+%%----------------------------------------------------------------------
+%%Controls the values of the If-Match and I-None-Mtch
+%%----------------------------------------------------------------------
+control_Etag(Path, Info, FileInfo)->
+    FileEtag = httpd_util:create_etag(FileInfo),
+    %%Control if the E-Tag for the resource  matches one of the Etags in
+    %%the -if-match header field
+    case control_match(Info, FileInfo, "if-match", FileEtag) of
+	nomatch ->
+	    %%None of the Etags in the if-match field matched the current 
+	    %%Etag for the resource return a 304 
+	    {412, Info, Path};
+	match ->
+	    continue;
+	undefined ->
+	    case control_match(Info, FileInfo, "if-none-match",  FileEtag) of
+		nomatch -> 
+		    continue;
+		match ->
+		    case  Info#mod.method of
+			"GET" ->
+			    {304, Info, Path};
+			"HEAD" ->
+			    {304, Info, Path};
+			_OtherrequestMethod ->
+			    {412, Info, Path}
+		    end;
+		undefined ->
+		    undefined
+	    end
+    end.
+
+%%----------------------------------------------------------------------
+%%Control if there are any Etags for HeaderField in the request if so 
+%%Control if they match the Etag for the requested file
+%%----------------------------------------------------------------------
+control_match(Info, _FileInfo, HeaderField, FileEtag)-> 
+    case split_etags(httpd_util:key1search(Info#mod.parsed_header,
+					   HeaderField)) of
+ 	undefined->
+	    undefined;
+        Etags->
+	    %%Control that the match any star not is availible 
+	    case lists:member("*",Etags) of
+		true-> 
+		    match;
+		false->
+		    compare_etags(FileEtag, Etags)
+	    end
+    end.
+
+%%----------------------------------------------------------------------
+%%Split the etags from the request
+%%----------------------------------------------------------------------
+split_etags(undefined)->
+    undefined;
+split_etags(Tags) ->
+    string:tokens(Tags,", ").
+
+%%----------------------------------------------------------------------
+%%Control if the etag for the file is in the list
+%%----------------------------------------------------------------------
+compare_etags(Tag,Etags) ->
+    case lists:member(Tag,Etags) of
+	true ->
+	    match;
+	_ ->
+	    nomatch
+    end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                   %%
+%%Control if the file is modificated                                 %%
+%%                                                                   %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%	    
+
+%%----------------------------------------------------------------------
+%%Control the If-Modified-Since and If-Not-Modified-Since header fields
+%%----------------------------------------------------------------------
+control_modification(Path,Info,FileInfo)->
+    ?DEBUG("control_modification() -> entry",[]),
+    case control_modification_data(Info,
+				   FileInfo#file_info.mtime,
+				   "if-modified-since") of
+	modified->
+	    continue;	
+	unmodified->
+	    {304, Info, Path};
+	undefined ->
+	    case control_modification_data(Info,
+					   FileInfo#file_info.mtime,
+					   "if-unmodified-since") of
+		modified  ->
+		    {412, Info, Path};
+		_ContinueUndefined ->
+		    continue	
+	    end
+    end.
+
+%%----------------------------------------------------------------------
+%%Controls the date from the http-request if-modified-since and 
+%%if-not-modified-since against the modification data of the
+%%File
+%%----------------------------------------------------------------------     
+%%Info is the record about the request
+%%ModificationTime is the time the file was edited last
+%%Header Field is the name of the field  to control
+
+control_modification_data(Info, ModificationTime, HeaderField)-> 
+    case strip_date(httpd_util:key1search(Info#mod.parsed_header,
+					  HeaderField)) of
+ 	undefined->
+	    undefined;
+	LastModified0 ->
+	    LastModified = calendar:universal_time_to_local_time(
+			     httpd_util:convert_request_date(LastModified0)),
+	    ?DEBUG("control_modification_data() -> "
+		   "~n   Request-Field:    ~s"
+		   "~n   FileLastModified: ~p"
+		   "~n   FieldValue:       ~p",
+		   [HeaderField, ModificationTime, LastModified]),
+	    FileTime =
+		calendar:datetime_to_gregorian_seconds(ModificationTime),
+	    FieldTime = calendar:datetime_to_gregorian_seconds(LastModified),
+	    if 
+		FileTime =< FieldTime ->
+		    ?DEBUG("File unmodified~n", []), unmodified;
+		FileTime >= FieldTime ->
+		    ?DEBUG("File modified~n", []), modified	    
+	    end
+    end.
+
+%% IE4 & NS4 sends an extra '; length=xxxx' string at the end of the If-Modified-Since
+%% header, we detect this and ignore it (the RFCs does not mention this).
+strip_date(undefined) ->
+    undefined;
+strip_date([]) ->
+    [];
+strip_date([$;,$ | _]) ->
+    [];
+strip_date([C | Rest]) ->
+    [C | strip_date(Rest)].
+
+send_return_value({412,_,_}, _FileInfo)->
+    {status,{412,none,"Precondition Failed"}};
+
+send_return_value({304,Info,Path}, FileInfo)->
+    Suffix = httpd_util:suffix(Path),
+    MimeType = httpd_util:lookup_mime_default(Info#mod.config_db,Suffix,
+					      "text/plain"),
+    LastModified =
+	case (catch httpd_util:rfc1123_date(FileInfo#file_info.mtime)) of
+	    Date when is_list(Date) ->
+		[{last_modified, Date}];
+	    _ -> %% This will rarly happen, but could happen
+		 %% if a computer is wrongly configured. 
+		[]
+	end,
+    
+    Header = [{code,304},
+	      {etag, httpd_util:create_etag(FileInfo)},
+	      {content_length,"0"}, {mime_type, MimeType} | LastModified],
+    {response, {response, Header, nobody}}.

Added: incubator/couchdb/trunk/src/couch_inets/mod_security.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_security.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_security.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_security.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,294 @@
+%% ``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_security).
+
+%% Security Audit Functionality
+
+%% User API exports
+-export([list_blocked_users/1, list_blocked_users/2, list_blocked_users/3, 
+	 block_user/4, block_user/5, 
+	 unblock_user/2, unblock_user/3, unblock_user/4,
+	 list_auth_users/1, list_auth_users/2, list_auth_users/3]).
+
+%% module API exports
+-export([do/1, load/2, store/2, remove/1]).
+
+-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,"SEC").
+
+
+%% do/1
+do(Info) ->
+    %% Check and see if any user has been authorized.
+    case httpd_util:key1search(Info#mod.data,remote_user,not_defined_user) of
+	not_defined_user ->
+	    %% No user has been authorized.
+	    case httpd_util:key1search(Info#mod.data, response) of
+		%% A status code has been generated!
+		{401, _Response} ->
+		    case httpd_util:key1search(Info#mod.parsed_header,
+					       "authorization") of
+			undefined ->
+			    %% Not an authorization attempt (server just replied to
+			    %% challenge for authentication)
+			    {proceed, Info#mod.data};
+			[$B,$a,$s,$i,$c,$ |EncodedString] ->
+			    %% Someone tried to authenticate, and obviously failed!
+			    DecodedString =  
+				case (catch 
+					  http_base_64:decode(
+					    EncodedString)) of
+				    %% Decode failed 
+				    {'EXIT',{function_clause, _}} ->
+					EncodedString;
+				    String ->
+					String
+				end,
+				 
+			    report_failed(Info, DecodedString,"Failed authentication"),
+			    take_failed_action(Info, DecodedString),
+			    {proceed, Info#mod.data}
+		    end;
+		_ ->
+		    {proceed, Info#mod.data}
+	    end;
+	User ->
+	    %% A user has been authenticated, now is he blocked ?
+	    Path = mod_alias:path(Info#mod.data,
+				  Info#mod.config_db,
+				  Info#mod.request_uri),
+	    {_Dir, SDirData} = secretp(Path, Info#mod.config_db),
+	    Addr = httpd_util:lookup(Info#mod.config_db, bind_address),
+	    Port = httpd_util:lookup(Info#mod.config_db, port),
+	    case mod_security_server:check_blocked_user(Info, User, 
+							SDirData, 
+							Addr, Port) of
+		true ->
+		    report_failed(Info, User ,"User Blocked"),
+		    {proceed, [{status, {403, Info#mod.request_uri, ""}}|Info#mod.data]};
+		false ->
+		    report_failed(Info, User,"Authentication Succedded"),
+		    mod_security_server:store_successful_auth(Addr, Port, 
+							      User, SDirData),
+		    {proceed, Info#mod.data}
+	    end
+    end.
+
+report_failed(Info, Auth, Event) ->
+    Request = Info#mod.request_line,
+    {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
+    String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++ " : " ++ Auth,
+    mod_disk_log:security_log(Info,String),
+    mod_log:security_log(Info, String).
+
+take_failed_action(Info, Auth) ->
+    Path = mod_alias:path(Info#mod.data, Info#mod.config_db, 
+			  Info#mod.request_uri),
+    {_Dir, SDirData} = secretp(Path, Info#mod.config_db),
+    Addr = httpd_util:lookup(Info#mod.config_db, bind_address),
+    Port = httpd_util:lookup(Info#mod.config_db, port),
+    mod_security_server:store_failed_auth(Info, Addr, Port, 
+					  Auth, SDirData).
+
+secretp(Path, ConfigDB) ->
+    Directories = ets:match(ConfigDB,{directory,'$1','_'}),
+    case secret_path(Path, Directories) of
+	{yes, Directory} ->
+	    SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory),
+	    SDir = lists:filter(fun(X) ->
+					lists:member({path, Directory}, X)
+				end, SDirs0),
+	    {Directory, lists:flatten(SDir)};
+	no ->
+	    {[], []}
+    end.
+
+secret_path(Path,Directories) ->
+    secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found).
+
+secret_path(_Path, [], to_be_found) ->
+    no;
+secret_path(_Path, [], Directory) ->
+    {yes, Directory};
+secret_path(Path, [[NewDirectory]|Rest], Directory) ->
+    case regexp:match(Path, NewDirectory) of
+	{match, _, _} when Directory == to_be_found ->
+	    secret_path(Path, Rest, NewDirectory);
+	{match, _, Length} when Length > length(Directory)->
+	    secret_path(Path, Rest, NewDirectory);
+	{match, _, _} ->
+	    secret_path(Path, Rest, Directory);
+	nomatch ->
+	    secret_path(Path, Rest, Directory)
+    end.
+
+
+load("<Directory " ++ Directory,[]) ->
+    Dir = httpd_conf:custom_clean(Directory,"",">"),
+    {ok, [{security_directory, Dir, [{path, Dir}]}]};
+load(eof,[{security_directory,Directory, _DirData}|_]) ->
+    {error, ?NICE("Premature end-of-file in "++Directory)};
+load("SecurityDataFile " ++ FileName,
+     [{security_directory, Dir, DirData}]) ->
+    File = httpd_conf:clean(FileName),
+    {ok, [{security_directory, Dir, [{data_file, File}|DirData]}]};
+load("SecurityCallbackModule " ++ ModuleName,
+     [{security_directory, Dir, DirData}]) ->
+    Mod = list_to_atom(httpd_conf:clean(ModuleName)),
+    {ok, [{security_directory, Dir, [{callback_module, Mod}|DirData]}]};
+load("SecurityMaxRetries " ++ Retries,
+     [{security_directory, Dir, DirData}]) ->
+    load_return_int_tag("SecurityMaxRetries", max_retries, 
+			httpd_conf:clean(Retries), Dir, DirData);
+load("SecurityBlockTime " ++ Time,
+      [{security_directory, Dir, DirData}]) ->
+	    load_return_int_tag("SecurityBlockTime", block_time,
+				httpd_conf:clean(Time), Dir, DirData);
+load("SecurityFailExpireTime " ++ Time,
+     [{security_directory, Dir, DirData}]) ->
+    load_return_int_tag("SecurityFailExpireTime", fail_expire_time,
+			httpd_conf:clean(Time), Dir, DirData);
+load("SecurityAuthTimeout " ++ Time0,
+     [{security_directory, Dir, DirData}]) ->
+    Time = httpd_conf:clean(Time0),
+    load_return_int_tag("SecurityAuthTimeout", auth_timeout,
+			httpd_conf:clean(Time), Dir, DirData);
+load("AuthName " ++ Name0,
+     [{security_directory, Dir, DirData}]) ->
+    Name = httpd_conf:clean(Name0),
+    {ok, [{security_directory, Dir, [{auth_name, Name}|DirData]}]};
+load("</Directory>",[{security_directory,Directory, DirData}]) ->
+    {ok, [], {security_directory, Directory, DirData}}.
+
+load_return_int_tag(Name, Atom, Time, Dir, DirData) ->
+    case Time of
+	"infinity" ->
+	    {ok, [{security_directory, Dir, [{Atom, 99999999999999999999999999999}|DirData]}]};
+	_Int ->
+	    case catch list_to_integer(Time) of
+		{'EXIT', _} ->
+		    {error, Time++" is an invalid "++Name};
+		Val ->
+		    {ok, [{security_directory, Dir, [{Atom, Val}|DirData]}]}
+	    end
+    end.
+
+store({security_directory, _Dir0, DirData}, ConfigList) ->
+    Addr = httpd_util:key1search(ConfigList, bind_address),
+    Port = httpd_util:key1search(ConfigList, port),
+    mod_security_server:start(Addr, Port),
+    SR = httpd_util:key1search(ConfigList, server_root),
+    
+    case httpd_util:key1search(DirData, data_file, no_data_file) of
+	no_data_file ->
+	    {error, no_security_data_file};
+	DataFile0 ->
+	    DataFile = 
+		case filename:pathtype(DataFile0) of
+		    relative ->
+			filename:join(SR, DataFile0);
+		    _ ->
+			DataFile0
+		end,
+	    case mod_security_server:new_table(Addr, Port, DataFile) of
+		{ok, TwoTables} ->
+		    NewDirData0 = lists:keyreplace(data_file, 1, DirData, 
+						   {data_file, TwoTables}),
+		    NewDirData1 = case Addr of
+				      undefined ->
+					  [{port,Port}|NewDirData0];
+				      _ ->
+					  [{port,Port},{bind_address,Addr}|
+					   NewDirData0]
+				  end,
+		    {ok, {security_directory,NewDirData1}};
+		{error, Err} ->
+		    {error, {{open_data_file, DataFile}, Err}}
+	    end
+    end.
+
+
+remove(ConfigDB) ->
+    Addr = case ets:lookup(ConfigDB, bind_address) of
+	       [] -> 
+		   undefined;
+	       [{bind_address, Address}] ->
+		   Address
+	   end,
+    [{port, Port}] = ets:lookup(ConfigDB, port),
+    mod_security_server:delete_tables(Addr, Port),
+    mod_security_server:stop(Addr, Port).
+    
+
+%%
+%% User API
+%%
+
+%% list_blocked_users
+
+list_blocked_users(Port) ->
+    list_blocked_users(undefined, Port).
+
+list_blocked_users(Port, Dir) when integer(Port) ->
+    list_blocked_users(undefined,Port,Dir);
+list_blocked_users(Addr, Port) when integer(Port) ->
+    mod_security_server:list_blocked_users(Addr, Port).
+
+list_blocked_users(Addr, Port, Dir) ->
+    mod_security_server:list_blocked_users(Addr, Port, Dir).
+
+
+%% block_user
+
+block_user(User, Port, Dir, Time) ->
+    block_user(User, undefined, Port, Dir, Time).
+block_user(User, Addr, Port, Dir, Time) ->
+    mod_security_server:block_user(User, Addr, Port, Dir, Time).
+
+
+%% unblock_user
+
+unblock_user(User, Port) ->
+    unblock_user(User, undefined, Port).
+
+unblock_user(User, Port, Dir) when integer(Port) ->
+    unblock_user(User, undefined, Port, Dir);
+unblock_user(User, Addr, Port) when integer(Port) ->
+    mod_security_server:unblock_user(User, Addr, Port).
+
+unblock_user(User, Addr, Port, Dir) ->
+    mod_security_server:unblock_user(User, Addr, Port, Dir).
+
+
+%% list_auth_users
+
+list_auth_users(Port) ->
+    list_auth_users(undefined,Port).
+
+list_auth_users(Port, Dir) when integer(Port) ->
+    list_auth_users(undefined, Port, Dir);
+list_auth_users(Addr, Port) when integer(Port) ->
+    mod_security_server:list_auth_users(Addr, Port).
+
+list_auth_users(Addr, Port, Dir) ->
+    mod_security_server:list_auth_users(Addr, Port, Dir).

Added: incubator/couchdb/trunk/src/couch_inets/mod_security_server.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_security_server.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_security_server.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_security_server.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,628 @@
+%% ``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$
+%%
+%% Security Audit Functionality
+
+%%
+%% The gen_server code.
+%%
+%% A gen_server is needed in this module to take care of shared access to the
+%% data file used to store failed and successful authentications aswell as 
+%% user blocks.
+%%
+%% The storage model is a write-through model with both an ets and a dets 
+%% table. Writes are done to both the ets and then the dets table, but reads 
+%% are only done from the ets table.
+%%
+%% This approach also enables parallelism when using dets by returning the 
+%% same dets table identifier when opening several files with the same 
+%% physical location.
+%%
+%% NOTE: This could be implemented using a single dets table, as it is 
+%%       possible to open a dets file with the ram_file flag, but this 
+%%       would require periodical sync's to disk, and it would be hard 
+%%       to decide when such an operation should occur.
+%%
+
+
+-module(mod_security_server).
+
+-include("httpd.hrl").
+
+-behaviour(gen_server).
+
+
+%% User API exports (called via mod_security)
+-export([list_blocked_users/2, list_blocked_users/3, 
+	 block_user/5, 
+	 unblock_user/3, unblock_user/4,
+	 list_auth_users/2, list_auth_users/3]).
+
+%% Internal exports (for mod_security only)
+-export([start/2, stop/1, stop/2,
+	 new_table/3, delete_tables/2, 
+	 store_failed_auth/5, store_successful_auth/4, 
+	 check_blocked_user/5]).
+
+%% gen_server exports
+-export([start_link/2, init/1, 
+	 handle_info/2, handle_call/3, handle_cast/2, 
+	 terminate/2,
+	 code_change/3]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                  %%
+%% 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
+%% Called  by the mod_security module.
+
+start(Addr, Port) ->
+    Name = make_name(Addr, Port),
+    case whereis(Name) of
+	undefined ->
+	   httpd_misc_sup:start_sec_server(Addr, Port);
+	_ -> %% Already started...
+	    ok
+    end.
+
+
+%% stop
+
+stop(Port) ->
+    stop(undefined, Port).
+stop(Addr, Port) ->
+    Name = make_name(Addr, Port),
+    case whereis(Name) of
+	undefined ->
+	    ok;
+	_ ->
+	    httpd_misc_sup:stop_sec_server(Addr, Port)
+    end.
+
+
+%% list_blocked_users
+
+list_blocked_users(Addr, Port) ->
+    Name = make_name(Addr,Port),
+    Req  = {list_blocked_users, Addr, Port, '_'},
+    call(Name, Req).
+
+list_blocked_users(Addr, Port, Dir) ->
+    Name = make_name(Addr, Port),
+    Req  = {list_blocked_users, Addr, Port, Dir},
+    call(Name, Req).
+
+
+%% block_user
+
+block_user(User, Addr, Port, Dir, Time) ->
+    Name = make_name(Addr, Port),
+    Req  = {block_user, User, Addr, Port, Dir, Time},
+    call(Name, Req).
+
+
+%% unblock_user
+
+unblock_user(User, Addr, Port) ->
+    Name = make_name(Addr, Port),
+    Req  = {unblock_user, User, Addr, Port, '_'},
+    call(Name, Req).
+
+unblock_user(User, Addr, Port, Dir) ->
+    Name = make_name(Addr, Port),
+    Req  = {unblock_user, User, Addr, Port, Dir},
+    call(Name, Req).
+
+
+%% list_auth_users
+
+list_auth_users(Addr, Port) ->
+    Name = make_name(Addr, Port),
+    Req  = {list_auth_users, Addr, Port, '_'},
+    call(Name, Req).
+
+list_auth_users(Addr, Port, Dir) ->
+    Name = make_name(Addr,Port),
+    Req  = {list_auth_users, Addr, Port, Dir}, 
+    call(Name, Req).
+    
+
+%% new_table
+
+new_table(Addr, Port, TabName) ->
+    Name = make_name(Addr,Port),
+    Req  = {new_table, Addr, Port, TabName}, 
+    call(Name, Req).
+
+
+%% delete_tables
+    
+delete_tables(Addr, Port) ->
+    Name = make_name(Addr, Port),
+    case whereis(Name) of
+	undefined ->
+	    ok;
+	_ ->
+	    call(Name, delete_tables)
+    end.
+
+
+%% store_failed_auth
+
+store_failed_auth(Info, Addr, Port, DecodedString, SDirData) ->
+    Name = make_name(Addr,Port),
+    Msg  = {store_failed_auth,[Info,DecodedString,SDirData]},
+    cast(Name, Msg).
+
+
+%% store_successful_auth
+
+store_successful_auth(Addr, Port, User, SDirData) ->
+    Name = make_name(Addr,Port),
+    Msg  = {store_successful_auth, [User,Addr,Port,SDirData]}, 
+    cast(Name, Msg).
+    
+
+%% check_blocked_user
+
+check_blocked_user(Info, User, SDirData, Addr, Port) ->
+    Name = make_name(Addr, Port),
+    Req  = {check_blocked_user, [Info, User, SDirData]}, 
+    call(Name, Req).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                  %%
+%% Server call-back functions                                       %%
+%%                                                                  %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+init(_) ->
+    process_flag(trap_exit, true),
+    {ok, []}.
+
+handle_call(stop, _From, _Tables) ->
+    {stop, normal, ok, []};
+
+handle_call({block_user, User, Addr, Port, Dir, Time}, _From, Tables) ->
+    Ret = block_user_int({User, Addr, Port, Dir, Time}),
+    {reply, Ret, Tables};
+
+handle_call({list_blocked_users, Addr, Port, Dir}, _From, Tables) ->
+    Blocked = list_blocked(Tables, Addr, Port, Dir, []),
+    {reply, Blocked, Tables};
+
+handle_call({unblock_user, User, Addr, Port, Dir}, _From, Tables) ->
+    Ret = unblock_user_int({User, Addr, Port, Dir}),
+    {reply, Ret, Tables};
+
+handle_call({list_auth_users, Addr, Port, Dir}, _From, Tables) ->
+    Auth = list_auth(Tables, Addr, Port, Dir, []),
+    {reply, Auth, Tables};
+
+handle_call({new_table, Addr, Port, Name}, _From, Tables) ->
+    case lists:keysearch(Name, 1, Tables) of
+	{value, {Name, {Ets, Dets}}} ->
+	    {reply, {ok, {Ets, Dets}}, Tables};
+	false ->
+	    TName = make_name(Addr,Port,length(Tables)),
+	    case dets:open_file(TName, [{type, bag}, {file, Name}, 
+					{repair, true}, 
+					{access, read_write}]) of
+		{ok, DFile} ->
+		    ETS = ets:new(TName, [bag, private]),
+		    sync_dets_to_ets(DFile, ETS),
+		    NewTables = [{Name, {ETS, DFile}}|Tables],
+		    {reply, {ok, {ETS, DFile}}, NewTables};
+		{error, Err} ->
+		    {reply, {error, {create_dets, Err}}, Tables}
+	    end
+    end;
+
+handle_call(delete_tables, _From, Tables) ->
+    lists:foreach(fun({_Name, {ETS, DETS}}) ->
+			  dets:close(DETS),
+			  ets:delete(ETS)
+		  end, Tables),
+    {reply, ok, []};
+
+handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) ->
+    {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
+    Dir = httpd_util:key1search(SDirData, path),
+    Addr = httpd_util:key1search(SDirData, bind_address),
+    Port = httpd_util:key1search(SDirData, port),
+    CBModule = 
+	httpd_util:key1search(SDirData, callback_module, no_module_at_all),
+    Ret = 
+	check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
+    {reply, Ret, Tables};
+
+handle_call(_Request,_From,Tables) ->
+    {reply,ok,Tables}.
+
+
+%% handle_cast
+
+handle_cast({store_failed_auth, [_, _, []]}, Tables) ->
+    %% Some other authentication scheme than mod_auth (example mod_htacess)
+    %% was the source for the authentication failure so we should ignor it!
+    {noreply, Tables};
+handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) ->
+    {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
+    Dir  = httpd_util:key1search(SDirData, path),
+    Addr = httpd_util:key1search(SDirData, bind_address),
+    Port = httpd_util:key1search(SDirData, port),
+    {ok, [User,Password]} = httpd_util:split(DecodedString,":",2),
+    Seconds = universal_time(),
+    Key = {User, Dir, Addr, Port},
+    %% Event
+    CBModule = httpd_util:key1search(SDirData, 
+				     callback_module, no_module_at_all),
+    auth_fail_event(CBModule,Addr,Port,Dir,User,Password),
+    
+    %% Find out if any of this user's other failed logins are too old to keep..
+    case ets:match_object(ETS, {failed, {Key, '_', '_'}}) of
+	[] ->
+	    no;
+	List ->
+	    ExpireTime = httpd_util:key1search(SDirData, 
+					       fail_expire_time, 30)*60,
+	    lists:map(fun({failed, {TheKey, LS, Gen}}) ->
+			      Diff = Seconds-LS,
+			      if
+				  Diff > ExpireTime ->
+				      ets:match_delete(ETS, 
+						       {failed, 
+							{TheKey, LS, Gen}}),
+				      dets:match_delete(DETS, 
+							{failed, 
+							 {TheKey, LS, Gen}});
+				  true ->
+				      ok
+			      end
+		      end,
+		      List)
+    end,
+
+    %% Insert the new failure..
+    Generation = length(ets:match_object(ETS, {failed, {Key, '_', '_'}})),
+    ets:insert(ETS, {failed, {Key, Seconds, Generation}}),
+    dets:insert(DETS, {failed, {Key, Seconds, Generation}}),
+    
+    %% See if we should block this user..
+    MaxRetries = httpd_util:key1search(SDirData, max_retries, 3),
+    BlockTime = httpd_util:key1search(SDirData, block_time, 60),
+    case ets:match_object(ETS, {failed, {Key, '_', '_'}}) of
+	List1 when length(List1) >= MaxRetries ->
+	    %% Block this user until Future
+	    Future = Seconds+BlockTime*60,
+	    Reason = io_lib:format("Blocking user ~s from dir ~s "
+				   "for ~p minutes", 
+				   [User, Dir, BlockTime]),
+	    mod_log:security_log(Info, lists:flatten(Reason)),
+	    
+	    %% Event
+	    user_block_event(CBModule,Addr,Port,Dir,User),
+	    
+	    ets:match_delete(ETS,{blocked_user,
+				  {User, Addr, Port, Dir, '$1'}}), 
+	    dets:match_delete(DETS, {blocked_user,
+				     {User, Addr, Port, Dir, '$1'}}),
+	    BlockRecord = {blocked_user, 
+			   {User, Addr, Port, Dir, Future}},
+	    ets:insert(ETS, BlockRecord),
+	    dets:insert(DETS, BlockRecord),
+	    %% Remove previous failed requests.
+	    ets:match_delete(ETS, {failed, {Key, '_', '_'}}),
+	    dets:match_delete(DETS, {failed, {Key, '_', '_'}});
+	_ ->
+	    no
+    end,
+    {noreply, Tables};
+
+handle_cast({store_successful_auth, [User, Addr, Port, SDirData]}, Tables) ->
+    {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
+    AuthTimeOut = httpd_util:key1search(SDirData, auth_timeout, 30),
+    Dir = httpd_util:key1search(SDirData, path),
+    Key = {User, Dir, Addr, Port},
+
+    %% Remove failed entries for this Key
+    dets:match_delete(DETS, {failed, {Key, '_', '_'}}),
+    ets:match_delete(ETS, {failed, {Key, '_', '_'}}), 
+
+    %% Keep track of when the last successful login took place.
+    Seconds = universal_time()+AuthTimeOut,
+    ets:match_delete(ETS, {success, {Key, '_'}}),
+    dets:match_delete(DETS, {success, {Key, '_'}}),
+    ets:insert(ETS, {success, {Key, Seconds}}),
+    dets:insert(DETS, {success, {Key, Seconds}}),
+    {noreply, Tables};
+	    
+handle_cast(Req, Tables) ->
+    error_msg("security server got unknown cast: ~p",[Req]),
+    {noreply, Tables}.
+
+
+%% handle_info
+
+handle_info(_Info, State) ->
+    {noreply, State}.
+
+
+%% terminate
+
+terminate(_Reason, _Tables) ->
+    ok.
+
+
+%% code_change({down, ToVsn}, State, Extra)
+%% 
+code_change({down, _}, State, _Extra) ->
+    {ok, State};
+
+
+%% code_change(FromVsn, State, Extra)
+%%
+code_change(_, State, _Extra) ->
+    {ok, State}.
+
+%% block_user_int/2
+block_user_int({User, Addr, Port, Dir, Time}) ->
+    Dirs = httpd_manager:config_match(Addr, Port, {security_directory, '_'}),
+    case find_dirdata(Dirs, Dir) of
+	{ok, DirData, {ETS, DETS}} ->
+	    Time1 = 
+		case Time of
+		    infinity ->
+			99999999999999999999999999999;
+		    _ ->
+			Time
+		end,
+	    Future = universal_time()+Time1,
+	    ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Dir,'_'}}),
+	    dets:match_delete(DETS, {blocked_user, 
+				     {User,Addr,Port,Dir,'_'}}),
+	    ets:insert(ETS, {blocked_user, {User,Addr,Port,Dir,Future}}),
+	    dets:insert(DETS, {blocked_user, {User,Addr,Port,Dir,Future}}),
+	    CBModule = httpd_util:key1search(DirData, callback_module, 
+					     no_module_at_all),
+	    user_block_event(CBModule,Addr,Port,Dir,User),
+	    true;
+	_ ->
+	    {error, no_such_directory}
+    end.
+    
+
+find_dirdata([], _Dir) ->
+    false;
+find_dirdata([{security_directory, DirData}|SDirs], Dir) ->
+    case lists:keysearch(path, 1, DirData) of
+	{value, {path, Dir}} ->
+	    {value, {data_file, {ETS, DETS}}} =
+		lists:keysearch(data_file, 1, DirData),
+	    {ok, DirData, {ETS, DETS}};
+	_ ->
+	    find_dirdata(SDirs, Dir)
+    end.
+
+%% unblock_user_int/2
+
+unblock_user_int({User, Addr, Port, Dir}) ->
+    Dirs = httpd_manager:config_match(Addr, Port, {security_directory, '_'}),
+    case find_dirdata(Dirs, Dir) of
+	{ok, DirData, {ETS, DETS}} ->
+	    case ets:match_object(ETS,
+				  {blocked_user,{User,Addr,Port,Dir,'_'}}) of
+		[] ->
+		    {error, not_blocked};
+		_Objects ->
+		    ets:match_delete(ETS, {blocked_user,
+					   {User, Addr, Port, Dir, '_'}}),
+		    dets:match_delete(DETS, {blocked_user,
+					     {User, Addr, Port, Dir, '_'}}),
+	       	    CBModule = httpd_util:key1search(DirData, 
+						     callback_module, 
+						     no_module_at_all),
+		    user_unblock_event(CBModule,Addr,Port,Dir,User),
+		    true
+	    end;
+	_ ->
+	    {error, no_such_directory}
+    end.
+
+
+
+%% list_auth/2
+
+list_auth([], _Addr, _Port, _Dir, Acc) ->
+    Acc;
+list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) ->
+    case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port}, '_'}}) of
+	[] ->
+	    list_auth(Tables, Addr, Port, Dir, Acc);
+	List ->
+	    TN = universal_time(),
+	    NewAcc = lists:foldr(fun({success,{{U,Ad,P,D},T}},Ac) -> 
+					 if
+					     T-TN > 0 ->
+						 [U|Ac];
+					     true ->
+						 Rec = {success,
+							{{U,Ad,P,D},T}},
+						 ets:match_delete(ETS,Rec),
+						 dets:match_delete(DETS,Rec),
+						 Ac
+					 end
+				 end,
+				 Acc, List),
+	    list_auth(Tables, Addr, Port, Dir, NewAcc)
+    end.
+
+
+%% list_blocked/2
+
+list_blocked([], _Addr, _Port, _Dir, Acc) ->
+    TN = universal_time(),
+    lists:foldl(fun({U,Ad,P,D,T}, Ac) ->
+			if
+			    T-TN > 0 ->
+				[{U,Ad,P,D,local_time(T)}|Ac];
+			    true ->
+				Ac
+			end
+		end, 
+		[], Acc);
+list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Dir, Acc) ->
+    List = ets:match_object(ETS, {blocked_user, 
+				  {'_',Addr,Port,Dir,'_'}}),
+    
+    NewBlocked = lists:foldl(fun({blocked_user, X}, A) -> 
+				     [X|A] end, Acc, List),
+    
+    list_blocked(Tables, Addr, Port, Dir, NewBlocked).
+
+
+%%
+%% sync_dets_to_ets/2
+%%
+%% Reads dets-table DETS and syncronizes it with the ets-table ETS.
+%%
+sync_dets_to_ets(DETS, ETS) ->
+    dets:traverse(DETS, fun(X) ->
+				ets:insert(ETS, X),
+				continue
+			end).
+
+%%
+%% check_blocked_user/7 -> true | false
+%%
+%% Check if a specific user is blocked from access.
+%%
+%% The sideeffect of this routine is that it unblocks also other users
+%% whos blocking time has expired. This to keep the tables as small
+%% as possible.
+%%
+check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) ->
+    TN = universal_time(),
+    BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_'}}), 
+    Blocked = lists:foldl(fun({blocked_user, X}, A) ->
+				  [X|A] end, [], BlockList),
+    check_blocked_user(Info,User,Dir,
+		       Addr,Port,ETS,DETS,TN,Blocked,CBModule).
+
+check_blocked_user(_Info, _User, _Dir, _Addr, _Port, _ETS, _DETS, _TN,
+		   [], _CBModule) ->
+    false;
+check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, 
+		   [{User,Addr,Port,Dir,T}| _], CBModule) ->
+    TD = T-TN,
+    if
+	TD =< 0 ->
+	    %% Blocking has expired, remove and grant access.
+	    unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
+	    false;
+	true ->
+	    true
+    end;
+check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, 
+		   [{OUser,ODir,OAddr,OPort,T}|Ls], CBModule) ->
+    TD = T-TN,
+    if
+	TD =< 0 ->
+	    %% Blocking has expired, remove.
+	    unblock_user(Info, OUser, ODir, OAddr, OPort, 
+			 ETS, DETS, CBModule);
+	true ->
+	    true
+    end,
+    check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, 
+		       TN, Ls, CBModule).
+
+unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) ->
+    Reason =
+	io_lib:format("User ~s was removed from the block list for dir ~s",
+			 [User, Dir]),
+    mod_log:security_log(Info, lists:flatten(Reason)),
+    user_unblock_event(CBModule,Addr,Port,Dir,User),
+    dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '_'}}),
+    ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Dir, '_'}}).
+  
+
+make_name(Addr,Port) ->
+    httpd_util:make_name("httpd_security",Addr,Port).
+
+make_name(Addr,Port,Num) ->
+    httpd_util:make_name("httpd_security",Addr,Port,
+			 "__" ++ integer_to_list(Num)).
+
+
+auth_fail_event(Mod,Addr,Port,Dir,User,Passwd) ->
+    event(auth_fail,Mod,Addr,Port,Dir,[{user,User},{password,Passwd}]).
+
+user_block_event(Mod,Addr,Port,Dir,User) ->
+    event(user_block,Mod,Addr,Port,Dir,[{user,User}]).
+
+user_unblock_event(Mod,Addr,Port,Dir,User) ->
+    event(user_unblock,Mod,Addr,Port,Dir,[{user,User}]).
+
+event(Event,Mod,undefined,Port,Dir,Info) ->
+    (catch Mod:event(Event,Port,Dir,Info));
+event(Event,Mod,Addr,Port,Dir,Info) ->
+    (catch Mod:event(Event,Addr,Port,Dir,Info)).
+
+universal_time() ->
+    calendar:datetime_to_gregorian_seconds(calendar:universal_time()).
+
+local_time(T) ->
+    calendar:universal_time_to_local_time(
+      calendar:gregorian_seconds_to_datetime(T)).
+
+
+error_msg(F, A) ->
+    error_logger:error_msg(F, A).
+
+
+call(Name, Req) ->
+    case (catch gen_server:call(Name, Req)) of
+        {'EXIT', Reason} ->
+            {error, Reason};
+        Reply ->
+            Reply
+    end.
+
+
+cast(Name, Msg) ->
+    case (catch gen_server:cast(Name, Msg)) of
+        {'EXIT', Reason} ->
+            {error, Reason};
+        Result ->
+            Result
+    end.

Added: incubator/couchdb/trunk/src/couch_inets/mod_trace.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_trace.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_trace.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_trace.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,87 @@
+%% ``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_trace).
+
+-export([do/1]).
+
+-include("httpd.hrl").
+
+
+do(Info) ->
+    %%?vtrace("do",[]),
+    case Info#mod.method of
+	"TRACE" ->
+	    case response_generated(Info) of
+		false->
+		    generate_trace_response(Info);
+	        true->
+		    {proceed,Info#mod.data}
+	    end;
+	_ ->
+	    {proceed,Info#mod.data}
+    end.
+
+
+%%---------------------------------------------------------------------
+%%Generate the trace response the trace response consists of a 
+%%http-header and the body will be the request.
+%5----------------------------------------------------------------------
+
+generate_trace_response(Info)->
+    RequestHead=Info#mod.parsed_header,
+    Body=generate_trace_response_body(RequestHead),
+    Len = length(Info#mod.request_line ++ Body),
+    Response=["HTTP/1.1 200 OK\r\n",
+	      "Content-Type:message/http\r\n",
+	      "Content-Length:",integer_to_list(Len),"\r\n\r\n",
+	      Info#mod.request_line,Body],
+    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,Response),
+    {proceed,[{response,{already_sent,200,Len}}|Info#mod.data]}.
+
+generate_trace_response_body(Parsed_header)->
+    generate_trace_response_body(Parsed_header,[]).
+
+generate_trace_response_body([],Head)->
+    lists:flatten(Head);
+generate_trace_response_body([{[],[]}|Rest],Head) ->
+    generate_trace_response_body(Rest,Head);
+generate_trace_response_body([{Field,Value}|Rest],Head) ->
+    generate_trace_response_body(Rest,[Field ++ ":" ++ Value ++ "\r\n"|Head]).
+
+
+
+%%----------------------------------------------------------------------
+%%Function that controls whether a response is generated or not
+%%----------------------------------------------------------------------
+response_generated(Info)->
+    case httpd_util:key1search(Info#mod.data,status) of
+	%% A status code has been generated!
+	{_StatusCode,_PhraseArgs,_Reason}->
+	    true;
+	%%No status code control repsonsxe
+	undefined ->
+	    case httpd_util:key1search(Info#mod.data, response) of
+		%% No response has been generated!
+		undefined ->
+		    false;
+		%% A response has been generated or sent!
+		_Response ->
+		    true
+	    end
+    end.
+

Added: incubator/couchdb/trunk/src/couch_inets/tftp.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/tftp.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/tftp.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/tftp.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,310 @@
+%%%-------------------------------------------------------------------
+%%% File    : tftp.erl
+%%% Author  : Hakan Mattsson <hakan@erix.ericsson.se>
+%%% Description : Trivial FTP
+%%% Created : 18 May 2004 by Hakan Mattsson <hakan@erix.ericsson.se>
+%%%-------------------------------------------------------------------
+%%% 
+%%% This is a complete implementation of the following IETF standards:
+%%%
+%%%    RFC 1350, The TFTP Protocol (revision 2).
+%%%    RFC 2347, TFTP Option Extension.
+%%%    RFC 2348, TFTP Blocksize Option.
+%%%    RFC 2349, TFTP Timeout Interval and Transfer Size Options.
+%%%
+%%% The only feature that not is implemented in this release is
+%%% the "netascii" transfer mode.
+%%%
+%%% The start/1 function starts a daemon process which, listens for
+%%% UDP packets on a port. When it receives a request for read or
+%%% write it spawns a temporary server process which handles the
+%%% actual transfer of the file. On the client side the read_file/3
+%%% and write_file/3 functions spawns a temporary client process which
+%%% establishes contact with a TFTP daemon and performs the actual
+%%% transfer of the file.
+%%%
+%%% Most of the options are common for both the client and the server
+%%% side, but some of them differs a little. Here are the available
+%%% options:
+%%%     
+%%%   {debug, Level}
+%%%
+%%%     Level = none | brief | normal | verbose | all
+%%%     
+%%%     Controls the level of debug printouts. The default is none.
+%%%     
+%%%   {host, Host}
+%%%
+%%%     The name or IP address of the host where the TFTP daemon
+%%%     resides. This option is only used by the client. See
+%%%     'inet' about valid host names.
+%%%     
+%%%   {port, Port}
+%%%
+%%%     Port = integer()
+%%%     
+%%%     The TFTP port where the daemon listens. It defaults to the
+%%%     standardized number 69. On the server side it may sometimes
+%%%     make sense to set it to 0, which means that the daemon just
+%%%     will pick a free port (which is returned by the start/1
+%%%     function).
+%%%     
+%%%     If a socket has somehow already has been connected, the
+%%%     {udp, [{fd, integer()}]} option can be used to pass the
+%%%     open file descriptor to gen_udp. This can be automated
+%%%     a bit by using a command line argument stating the
+%%%     prebound file descriptor number. For example, if the
+%%%     Port is 69 and the file descriptor 22 has been opened by
+%%%     setuid_socket_wrap. Then the command line argument
+%%%     "-tftpd_69 22" will trigger the prebound file
+%%%     descriptor 22 to be used instead of opening port 69.
+%%%     The UDP option {udp, [{fd, 22}]} autmatically be added.
+%%%     See init:get_argument/ about command line arguments and
+%%%     gen_udp:open/2 about UDP options.
+%%%
+%%%   {port_policy, Policy}
+%%%
+%%%     Policy = random | Port | {range, MinPort, MaxPort}
+%%%     Port = MinPort = MaxPort = integer()
+%%%     
+%%%     Policy for the selection of the temporary port which is used
+%%%     by the server/client during the file transfer. It defaults to
+%%%     'random' which is the standardized policy. With this policy a
+%%%     randomized free port used. A single port or a range of ports
+%%%     can be useful if the protocol should pass thru a firewall.
+%%%   
+%%%   {prebound_fd, InitArgFlag}
+%%%
+%%%     InitArgFlag = atom()
+%%%
+%%%     If a socket has somehow already has been connected, the
+%%%     {udp, [{fd, integer()}]} option can be used to pass the
+%%%     open file descriptor to gen_udp.
+%%%
+%%%     The prebound_fd option makes it possible to pass give the
+%%%     file descriptor as a command line argument. The typical
+%%%     usage is when used in conjunction with setuid_socket_wrap
+%%%     to be able to open privileged sockets. For example if the
+%%%     file descriptor 22 has been opened by setuid_socket_wrap
+%%%     and you have choosen my_tftp_fd as init argument, the
+%%%     command line should like this "erl -my_tftp_fd 22" and 
+%%%     FileDesc should be set to my_tftpd_fd. This would 
+%%%     automatically imply {fd, 22} to be set as UDP option.
+%%%   
+%%%   {udp, UdpOptions}
+%%%
+%%%      Options to gen_udp:open/2.
+%%%
+%%%   {use_tsize, Bool}
+%%%
+%%%     Bool = boolean()
+%%%     
+%%%     Flag for automated usage of the "tsize" option. With this set
+%%%     to true, the write_file/3 client will determine the filesize
+%%%     and send it to the server as the standardized "tsize" option.
+%%%     A read_file/3 client will just acquire filesize from the
+%%%     server by sending a zero "tsize".
+%%%     
+%%%   {max_tsize, MaxTsize}
+%%%
+%%%     MaxTsize = integer() | infinity
+%%%     
+%%%     Threshold for the maximal filesize in bytes. The transfer will
+%%%     be aborted if the limit is exceeded. It defaults to
+%%%     'infinity'.
+%%%
+%%%   {max_conn, MaxConn}
+%%%   
+%%%     MaxConn = integer() | infinity
+%%%     
+%%%     Threshold for the maximal number of active connections. The
+%%%     daemon will reject the setup of new connections if the limit
+%%%     is exceeded. It defaults to 'infinity'.
+%%%     
+%%%   {TftpKey, TftpVal}
+%%%
+%%%      TftpKey = string()
+%%%      TftpVal = string()
+%%%
+%%%      The name and value of a TFTP option.
+%%%      
+%%%   {reject, Feature}
+%%%   
+%%%      Feature = Mode | TftpKey
+%%%      Mode    = read | write
+%%%      TftpKey = string()
+%%%      
+%%%      Control which features that should be rejected.
+%%%      This is mostly useful for the server as it may restrict
+%%%      usage of certain TFTP options or read/write access.
+%%%
+%%%   {callback, {RegExp, Module, State}}
+%%%
+%%%    	 RegExp = string()
+%%%    	 Module = atom()
+%%%    	 State  = term()
+%%%    	 
+%%%      Registration of a callback module. When a file is to be
+%%%      transferred, its local filename will be matched to the
+%%%      regular expressions of the registered callbacks. The first
+%%%      matching callback will be used the during the transfer.The
+%%%      callback module must implement the 'tftp' behaviour.
+%%%
+%%%      On the server side the callback interaction starts with a
+%%%      call to open/5 with the registered initial callback
+%%%      state. open/5 is expected to open the (virtual) file. Then
+%%%      either the read/1 or write/2 functions are invoked
+%%%      repeatedly, once per transfererred block. At each function
+%%%      call the state returned from the previous call is
+%%%      obtained. When the last block has been encountered the read/1
+%%%      or write/2 functions is expected to close the (virtual)
+%%%      file.and return its last state. The abort/3 function is only
+%%%      used in error situations. prepare/5 is not used on the server
+%%%      side.
+%%%      
+%%%      On the client side the callback interaction is the same, but
+%%%      it starts and ends a bit differently. It starts with a call
+%%%      to prepare/5 with the same arguments as open/5
+%%%      takes. prepare/5 is expected to validate the TFTP options,
+%%%      suggested by the user and return the subset of them that it
+%%%      accepts. Then the options is sent to the server which will
+%%%      perform the same TFTP option negotiation procedure. The
+%%%      options that are accepted by the server is forwarded to the
+%%%      open/5 function on the client side. On the client side the
+%%%      open/5 function must accept all option as is or reject the
+%%%      transfer. Then the callback interaction follows the same
+%%%      pattern as described above for the server side. When the last
+%%%      block is encountered in read/1 or write/2 the returned stated
+%%%      is forwarded to the user and returned from read_file/3 or
+%%%      write_file/3.
+%%%-------------------------------------------------------------------
+
+-module(tftp).
+
+%%-------------------------------------------------------------------
+%% Interface
+%%-------------------------------------------------------------------
+
+%% public functions
+-export([
+	 read_file/3,
+	 write_file/3,
+	 start/1,
+	 info/1,
+	 change_config/2,
+	 start/0
+	]).
+
+-export([behaviour_info/1]).
+
+behaviour_info(callbacks) ->
+    [{prepare, 6}, {open, 6}, {read, 1}, {write, 2}, {abort, 3}];
+behaviour_info(_) ->
+    undefined.
+
+-include("tftp.hrl").
+
+%%-------------------------------------------------------------------
+%% read_file(RemoteFilename, LocalFilename, Options) ->
+%%   {ok, LastCallbackState} | {error, Reason}
+%%
+%% RemoteFilename     = string()
+%% LocalFilename      = binary | string()
+%% Options            = [option()]
+%% LastCallbackState  = term()
+%% Reason             = term()
+%%
+%% Reads a (virtual) file from a TFTP server
+%%
+%% If LocalFilename is the atom 'binary', tftp_binary will be used as
+%% callback module. It will concatenate all transferred blocks and
+%% return them as one single binary in the CallbackState.
+%%
+%% When LocalFilename is a string, it will be matched to the
+%% registered callback modules and hopefully one of them will be
+%% selected. By default, tftp_file will be used as callback module. It
+%% will write each transferred block to the file named
+%% LocalFilename. The number of transferred bytes will be returned as
+%% LastCallbackState.
+%%-------------------------------------------------------------------
+
+read_file(RemoteFilename, LocalFilename, Options) ->
+    tftp_engine:client_start(read, RemoteFilename, LocalFilename, Options).
+    
+%%-------------------------------------------------------------------
+%% write(RemoteFilename, LocalFilename, Options) ->
+%%   {ok, LastCallbackState} | {error, Reason}
+%%
+%% RemoteFilename    = string()
+%% LocalFilename     = binary() | string()
+%% Options           = [option()]
+%% LastCallbackState = term()
+%% Reason            = term()
+%%
+%% Writes a (virtual) file to a TFTP server
+%% 
+%% If LocalFilename is a binary, tftp_binary will be used as callback
+%% module. The binary will be transferred block by block and the number
+%% of transferred bytes will be returned as LastCallbackState.
+%%
+%% When LocalFilename is a string, it will be matched to the
+%% registered callback modules and hopefully one of them will be
+%% selected. By default, tftp_file will be used as callback module. It
+%% will read the file named LocalFilename block by block. The number
+%% of transferred bytes will be returned as LastCallbackState.
+%%-------------------------------------------------------------------
+
+write_file(RemoteFilename, LocalFilename, Options) ->
+    tftp_engine:client_start(write, RemoteFilename, LocalFilename, Options).
+
+%%-------------------------------------------------------------------
+%% start(Options) -> {ok, Pid} | {error, Reason}
+%% 
+%% Options = [option()]
+%% Pid     = pid()
+%% Reason  = term()
+%%
+%% Starts a daemon process which listens for udp packets on a
+%% port. When it receives a request for read or write it spawns
+%% a temporary server process which handles the actual transfer
+%% of the (virtual) file.
+%%-------------------------------------------------------------------
+
+start(Options) ->
+    tftp_engine:daemon_start(Options).
+
+%%-------------------------------------------------------------------
+%% info(Pid) -> {ok, Options} | {error, Reason}
+%% 
+%% Options = [option()]
+%% Reason  = term()
+%%
+%% Returns info about a tftp daemon, server or client process
+%%-------------------------------------------------------------------
+
+info(Pid) ->
+    tftp_engine:info(Pid).
+
+%%-------------------------------------------------------------------
+%% change_config(Pid, Options) -> ok | {error, Reason}
+%% 
+%% Options = [option()]
+%% Reason  = term()
+%%
+%% Changes config for a tftp daemon, server or client process
+%% Must be used with care.
+%%-------------------------------------------------------------------
+
+change_config(Pid, Options) ->
+    tftp_engine:change_config(Pid, Options).
+
+%%-------------------------------------------------------------------
+%% start() -> ok | {error, Reason}
+%% 
+%% Reason = term()
+%%
+%% Start the application
+%%-------------------------------------------------------------------
+
+start() ->
+    application:start(inets).

Added: incubator/couchdb/trunk/src/couch_inets/tftp.hrl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/tftp.hrl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/tftp.hrl (added)
+++ incubator/couchdb/trunk/src/couch_inets/tftp.hrl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,47 @@
+%%%-------------------------------------------------------------------
+%%% Defines
+%%%-------------------------------------------------------------------
+
+-define(TFTP_DEFAULT_PORT,  69).% Default server port
+
+-define(TFTP_OPCODE_RRQ,    1). % Read request
+-define(TFTP_OPCODE_WRQ,    2). % Write request
+-define(TFTP_OPCODE_DATA,   3). % Data
+-define(TFTP_OPCODE_ACK,    4). % Acknowledgement
+-define(TFTP_OPCODE_ERROR,  5). % Error
+-define(TFTP_OPCODE_OACK,   6). % Option acknowledgment
+
+-define(TFTP_ERROR_UNDEF,   0). % Not defined, see error message (if any)
+-define(TFTP_ERROR_ENOENT,  1). % File not found.
+-define(TFTP_ERROR_EACCES,  2). % Access violation.
+-define(TFTP_ERROR_ENOSPC,  3). % Disk full or allocation exceeded.
+-define(TFTP_ERROR_BADOP,   4). % Illegal TFTP operation.
+-define(TFTP_ERROR_BADBLK,  5). % Unknown transfer ID.
+-define(TFTP_ERROR_EEXIST,  6). % File already exists.
+-define(TFTP_ERROR_BADUSER, 7). % No such user.
+-define(TFTP_ERROR_BADOPT,  8). % Unrequested or illegal option.
+
+-record(tftp_msg_req,     {access, filename, mode, options, local_filename}).
+-record(tftp_msg_data,    {block_no, data}).
+-record(tftp_msg_ack,     {block_no}).
+-record(tftp_msg_error,   {code, text, details}).
+-record(tftp_msg_oack,    {options}).
+
+-record(config, {parent_pid   = self(),
+		 udp_socket,
+		 udp_options  = [binary, {reuseaddr, true}, {active, once}],
+		 udp_host     = "localhost",
+		 udp_port     = ?TFTP_DEFAULT_PORT,
+		 port_policy  = random,
+		 use_tsize    = false,
+		 max_tsize    = infinity, % Filesize
+		 max_conn     = infinity,
+		 rejected     = [],
+		 polite_ack   = false,
+		 debug_level  = none,
+		 timeout,
+		 user_options = [],
+		 callbacks    = []}).
+
+-record(callback, {regexp, internal, module, state, block_no, count}).
+

Added: incubator/couchdb/trunk/src/couch_inets/tftp_binary.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/tftp_binary.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/tftp_binary.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/tftp_binary.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,181 @@
+%%%-------------------------------------------------------------------
+%%% File    : tft_binary.erl
+%%% Author  : Hakan Mattsson <hakan@erix.ericsson.se>
+%%% Description : 
+%%%
+%%% Created : 24 May 2004 by Hakan Mattsson <hakan@erix.ericsson.se>
+%%%-------------------------------------------------------------------
+
+-module(tftp_binary).
+
+%%%-------------------------------------------------------------------
+%%% Interface
+%%%-------------------------------------------------------------------
+
+-behaviour(tftp).
+
+-export([prepare/6, open/6, read/1, write/2, abort/3]).
+-export([prepare/5, open/5]).
+
+-record(read_state,  {options, blksize, bin,  is_network_ascii, count}).
+-record(write_state, {options, blksize, list, is_network_ascii}).
+
+%%-------------------------------------------------------------------
+%% Prepare
+%%-------------------------------------------------------------------
+
+prepare(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) ->
+    %% Kept for backwards compatibility 
+    prepare(Access, Filename, Mode, SuggestedOptions, Initial).
+
+prepare(Access, Bin, Mode, SuggestedOptions, []) ->
+    %% Client side
+    case catch handle_options(Access, Bin, Mode, SuggestedOptions) of
+	{ok, IsNetworkAscii, AcceptedOptions} when Access =:= read, binary(Bin) ->
+	    State = #read_state{options  	 = AcceptedOptions,
+				blksize  	 = lookup_blksize(AcceptedOptions),
+				bin      	 = Bin,
+				is_network_ascii = IsNetworkAscii,
+			        count            = size(Bin)},
+	    {ok, AcceptedOptions, State};
+	{ok, IsNetworkAscii, AcceptedOptions} when Access =:= write, Bin =:= binary ->
+	    State = #write_state{options  	  = AcceptedOptions,
+				 blksize  	  = lookup_blksize(AcceptedOptions),
+				 list     	  = [],
+				 is_network_ascii = IsNetworkAscii},
+	    {ok, AcceptedOptions, State};
+	{error, {Code, Text}} ->
+	    {error, {Code, Text}}
+    end;
+prepare(_Access, _Bin, _Mode, _SuggestedOptions, _Initial) ->
+    {error, {undef, "Illegal callback options."}}.
+
+%%-------------------------------------------------------------------
+%% Open
+%%-------------------------------------------------------------------
+
+open(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) ->
+    %% Kept for backwards compatibility 
+    open(Access, Filename, Mode, SuggestedOptions, Initial).
+
+open(Access, Bin, Mode, SuggestedOptions, []) ->
+    %% Server side
+    case prepare(Access, Bin, Mode, SuggestedOptions, []) of
+	{ok, AcceptedOptions, State} ->
+	    open(Access, Bin, Mode, AcceptedOptions, State);
+	{error, {Code, Text}} ->
+	    {error, {Code, Text}}
+    end;
+open(Access, Bin, Mode, NegotiatedOptions, State) ->
+    %% Both sides
+    IsNetworkAscii =
+	if
+	    is_record(State, write_state) -> State#write_state.is_network_ascii;
+	    is_record(State, read_state)  -> State#read_state.is_network_ascii
+	end,
+    case catch handle_options(Access, Bin, Mode, NegotiatedOptions) of
+	{ok, IsNetworkAscii2, Options}
+	when Options =:= NegotiatedOptions,
+	     IsNetworkAscii =:= IsNetworkAscii2 ->
+	    {ok, NegotiatedOptions, State};
+	{error, {Code, Text}} ->
+	    {error, {Code, Text}}
+    end.
+
+%%-------------------------------------------------------------------
+%% Read
+%%-------------------------------------------------------------------
+
+read(#read_state{bin = Bin} = State) when is_binary(Bin) ->
+    BlkSize = State#read_state.blksize,
+    if
+	size(Bin) >= BlkSize ->
+	    <<Block:BlkSize/binary, Bin2/binary>> = Bin,
+	    State2 = State#read_state{bin = Bin2},
+	    {more, Block, State2};
+	size(Bin) < BlkSize ->
+	    {last, Bin, State#read_state.count}
+    end.
+
+%%-------------------------------------------------------------------
+%% Write
+%%-------------------------------------------------------------------
+
+write(Bin, #write_state{list = List} = State) when is_binary(Bin), is_list(List) ->
+    Size = size(Bin),
+    BlkSize = State#write_state.blksize,
+    if
+	Size =:= BlkSize ->
+	    {more, State#write_state{list = [Bin | List]}};
+	Size < BlkSize ->
+	    Bin2 = list_to_binary(lists:reverse([Bin | List])),
+	    {last, Bin2}
+    end.
+
+%%-------------------------------------------------------------------
+%% Abort
+%%-------------------------------------------------------------------
+
+abort(_Code, _Text, #read_state{bin = Bin} = State) 
+  when record(State, read_state), binary(Bin) ->
+    ok;
+abort(_Code, _Text, #write_state{list = List} = State)
+  when record(State, write_state), list(List) ->
+    ok.
+
+%%-------------------------------------------------------------------
+%% Process options
+%%-------------------------------------------------------------------
+
+handle_options(Access, Bin, Mode, Options) ->
+    IsNetworkAscii = handle_mode(Mode),
+    Options2 = do_handle_options(Access, Bin, Options),
+    {ok, IsNetworkAscii, Options2}.
+
+handle_mode(Mode) ->
+    case Mode of
+	%% "netascii" -> true;
+	"octet"    -> false;
+	_          -> throw({error, {badop, "Illegal mode " ++ Mode}})
+    end.
+
+do_handle_options(Access, Bin, [{Key, Val} | T]) ->
+    case Key of
+	"tsize" ->
+	    case Access of
+		read when Val =:= "0", binary(Bin) ->
+		    Tsize = integer_to_list(size(Bin)),
+		    [{Key, Tsize} | do_handle_options(Access, Bin, T)];
+		_ ->
+		    handle_integer(Access, Bin, Key, Val, T, 0, infinity)
+	    end;
+	"blksize" ->
+	    handle_integer(Access, Bin, Key, Val, T, 8, 65464);
+	"timeout" ->
+	    handle_integer(Access, Bin, Key, Val, T, 1, 255);
+	_ ->
+	    do_handle_options(Access, Bin, T)
+    end;
+do_handle_options(_Access, _Bin, []) ->
+    [].
+
+
+handle_integer(Access, Bin, Key, Val, Options, Min, Max) ->
+    case catch list_to_integer(Val) of
+	{'EXIT', _} ->
+	    do_handle_options(Access, Bin, Options);
+	Int when Int >= Min, Int =< Max ->
+	    [{Key, Val} | do_handle_options(Access, Bin, Options)];
+	Int when Int >= Min, Max =:= infinity ->
+	    [{Key, Val} | do_handle_options(Access, Bin, Options)];
+	_Int ->
+	    throw({error, {badopt, "Illegal " ++ Key ++ " value " ++ Val}})
+    end.
+
+lookup_blksize(Options) ->
+    case lists:keysearch("blksize", 1, Options) of
+	{value, {_, Val}} ->
+	    list_to_integer(Val);
+	false ->
+	    512
+    end.



Mime
View raw message