couchdb-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From cml...@apache.org
Subject svn commit: r642432 [9/16] - in /incubator/couchdb/trunk: ./ bin/ build-contrib/ etc/ etc/conf/ etc/default/ etc/init/ etc/launchd/ etc/logrotate.d/ share/ share/server/ share/www/ share/www/browse/ share/www/image/ share/www/script/ share/www/style/ s...
Date Fri, 28 Mar 2008 23:32:30 GMT
Added: incubator/couchdb/trunk/src/couch_inets/httpd_util.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/httpd_util.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/httpd_util.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/httpd_util.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,718 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%% 
+%%     $Id$
+%%
+-module(httpd_util).
+-export([key1search/2, key1search/3, lookup/2, lookup/3, multi_lookup/2,
+	 lookup_mime/2, lookup_mime/3, lookup_mime_default/2,
+	 lookup_mime_default/3, reason_phrase/1, message/3, rfc1123_date/0,
+	 rfc1123_date/1, day/1, month/1, decode_hex/1, decode_base64/1,
+	 encode_base64/1,
+	 flatlength/1, split_path/1, split_script_path/1, suffix/1, to_upper/1,
+	 to_lower/1, split/3, uniq/1,
+	 make_name/2,make_name/3,make_name/4,strip/1,
+	 hexlist_to_integer/1,integer_to_hexlist/1,
+	 convert_request_date/1,create_etag/1,create_etag/2,
+	 convert_netscapecookie_date/1, enable_debug/1, valid_options/3]).
+
+-export([encode_hex/1]).
+-include_lib("kernel/include/file.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}}).
+-compile({nowarn_deprecated_function, {http_base_64, decode, 1}}).
+
+-deprecated([{to_lower, 1, next_major_release},
+	     {to_upper, 1, next_major_release},
+	     {decode_base64, 1, next_major_release},
+	     {encode_base64, 1, next_major_release}
+	    ]).
+
+%% key1search
+
+key1search(TupleList,Key) ->
+    key1search(TupleList,Key,undefined).
+
+key1search(TupleList,Key,Undefined) ->
+    case lists:keysearch(Key,1,TupleList) of
+	{value,{Key,Value}} ->
+	    Value;
+	false ->
+	    Undefined
+    end.
+
+%% lookup
+
+lookup(Table,Key) ->
+    lookup(Table,Key,undefined).
+
+lookup(Table,Key,Undefined) ->
+    case catch ets:lookup(Table,Key) of
+	[{Key,Value}|_] ->
+	    Value;
+	_->
+	    Undefined
+    end.
+
+%% multi_lookup
+
+multi_lookup(Table,Key) ->
+    remove_key(ets:lookup(Table,Key)).
+
+remove_key([]) ->
+    [];
+remove_key([{_Key, Value}| Rest]) ->
+    [Value | remove_key(Rest)].
+
+%% lookup_mime
+
+lookup_mime(ConfigDB,Suffix) ->
+    lookup_mime(ConfigDB,Suffix,undefined).
+
+lookup_mime(ConfigDB,Suffix,Undefined) ->
+    [{mime_types,MimeTypesDB}|_]=ets:lookup(ConfigDB,mime_types),
+    case ets:lookup(MimeTypesDB,Suffix) of
+	[] ->
+	    Undefined;
+	[{Suffix,MimeType}|_] ->
+	    MimeType
+    end.
+
+%% lookup_mime_default
+
+lookup_mime_default(ConfigDB,Suffix) ->
+    lookup_mime_default(ConfigDB,Suffix,undefined).
+
+lookup_mime_default(ConfigDB,Suffix,Undefined) ->
+    [{mime_types,MimeTypesDB}|_]=ets:lookup(ConfigDB,mime_types),
+    case ets:lookup(MimeTypesDB,Suffix) of
+	[] ->
+	    case ets:lookup(ConfigDB,default_type) of
+		[] ->
+		    Undefined;
+		[{default_type,DefaultType}|_] ->
+		    DefaultType
+	    end;
+	[{Suffix,MimeType}|_] ->
+	    MimeType
+    end.
+
+%%% RFC 2616, HTTP 1.1 Status codes
+reason_phrase(100) ->   "Continue";
+reason_phrase(101) ->   "Switching Protocols" ;
+reason_phrase(200) ->   "OK" ;
+reason_phrase(201) ->   "Created" ;
+reason_phrase(202) ->   "Accepted" ;
+reason_phrase(203) ->   "Non-Authoritative Information" ;
+reason_phrase(204) ->   "No Content" ;
+reason_phrase(205) ->   "Reset Content" ;
+reason_phrase(206) ->   "Partial Content" ;
+reason_phrase(300) ->   "Multiple Choices" ;
+reason_phrase(301) ->   "Moved Permanently" ;
+reason_phrase(302) ->   "Moved Temporarily" ;
+reason_phrase(303) ->   "See Other" ;
+reason_phrase(304) ->   "Not Modified" ;
+reason_phrase(305) ->   "Use Proxy" ;
+reason_phrase(306) ->   "(unused)" ;
+reason_phrase(307) ->   "Temporary Redirect" ;
+reason_phrase(400) ->   "Bad Request";
+reason_phrase(401) ->   "Unauthorized";
+reason_phrase(402) ->   "Payment Required";
+reason_phrase(403) ->   "Forbidden" ;
+reason_phrase(404) ->   "Object Not Found" ;
+reason_phrase(405) ->   "Method Not Allowed" ;
+reason_phrase(406) ->   "Not Acceptable" ;
+reason_phrase(407) ->   "Proxy Authentication Required" ;
+reason_phrase(408) ->   "Request Time-out" ;
+reason_phrase(409) ->   "Conflict" ;
+reason_phrase(410) ->   "Gone" ;
+reason_phrase(411) ->   "Length Required" ;
+reason_phrase(412) ->   "Precondition Failed" ;
+reason_phrase(413) ->   "Request Entity Too Large" ;
+reason_phrase(414) ->   "Request-URI Too Large" ;
+reason_phrase(415) ->   "Unsupported Media Type" ;
+reason_phrase(416) ->   "Requested Range Not Satisfiable" ;
+reason_phrase(417) ->   "Expectation Failed" ;
+reason_phrase(500) ->   "Internal Server Error" ;
+reason_phrase(501) ->   "Not Implemented" ;
+reason_phrase(502) ->   "Bad Gateway" ;
+reason_phrase(503) ->   "Service Unavailable" ;
+reason_phrase(504) ->   "Gateway Time-out" ;
+reason_phrase(505) ->   "HTTP Version not supported";
+
+%%% RFC 2518, HTTP Extensions for Distributed Authoring -- WEBDAV
+reason_phrase(102) ->   "Processing";
+reason_phrase(207) ->   "Multi-Status";
+reason_phrase(422) ->   "Unprocessable Entity";
+reason_phrase(423) ->   "Locked";
+reason_phrase(424) ->   "Failed Dependency";
+reason_phrase(507) ->   "Insufficient Storage";
+
+%%% (Work in Progress) WebDAV Advanced Collections
+reason_phrase(425) ->   "";
+
+%%% RFC 2817, HTTP Upgrade to TLS
+reason_phrase(426) ->   "Upgrade Required";
+
+%%% RFC 3229, Delta encoding in HTTP
+reason_phrase(226) ->   "IM Used";
+
+reason_phrase(_) -> "Internal Server Error".
+
+
+%% message
+
+message(301,URL,_) ->
+    "The document has moved <A HREF=\""++URL++"\">here</A>.";
+message(304, _URL,_) ->
+    "The document has not been changed.";
+message(400,none,_) ->
+    "Your browser sent a query that this server could not understand.";
+message(400,Msg,_) ->
+    "Your browser sent a query that this server could not understand. "++Msg;
+message(401,none,_) ->
+    "This server could not verify that you
+are authorized to access the document you
+	requested.  Either you supplied the wrong
+credentials (e.g., bad password), or your
+browser doesn't understand how to supply
+the credentials required.";
+message(403,RequestURI,_) ->
+    "You don't have permission to access "++RequestURI++" on this server.";
+message(404,RequestURI,_) ->
+    "The requested URL "++RequestURI++" was not found on this server.";
+message(408, Timeout, _) ->
+    Timeout;
+message(412,none,_) ->
+    "The requested preconditions where false";
+message(413, Reason,_) ->
+    "Entity: " ++ Reason;
+message(414,ReasonPhrase,_) ->
+    "Message "++ReasonPhrase++".";
+message(416,ReasonPhrase,_) ->
+    ReasonPhrase;
+
+message(500,_,ConfigDB) ->
+    ServerAdmin=lookup(ConfigDB,server_admin,"unknown@unknown"),
+    "The server encountered an internal error or "
+	"misconfiguration and was unable to complete "
+	"your request.<P>Please contact the server administrator "
+	++ ServerAdmin ++ ", and inform them of the time the error occurred "
+	"and anything you might have done that may have caused the error.";
+
+message(501,{Method, RequestURI, HTTPVersion}, _ConfigDB) ->
+    if
+	atom(Method) ->
+	    atom_to_list(Method)++
+		" to "++RequestURI++" ("++HTTPVersion++") not supported.";
+	list(Method) ->
+	    Method++
+		" to "++RequestURI++" ("++HTTPVersion++") not supported."
+    end;
+
+message(503, String, _ConfigDB) ->
+    "This service in unavailable due to: "++String.
+
+%%convert_rfc_date(Date)->{{YYYY,MM,DD},{HH,MIN,SEC}}
+
+convert_request_date([D,A,Y,DateType| Rest])->
+    Func=case DateType of
+	     $\, ->
+		 fun convert_rfc1123_date/1;
+	     $\  ->
+		 fun convert_ascii_date/1;
+	     _ ->
+		 fun convert_rfc850_date/1
+	 end,
+    case catch Func([D,A,Y,DateType| Rest]) of
+	{ok,Date} ->
+	    Date;
+	_Error->
+	    bad_date
+    end.
+convert_rfc850_date(DateStr) ->
+    [_WeekDay,Date,Time,_TimeZone|_Rest] = string:tokens(DateStr," "), 
+    convert_rfc850_date(Date,Time).
+
+convert_rfc850_date([D1,D2,_,
+		     M,O,N,_,
+		     Y1,Y2|_Rest],[H1,H2,_Col,M1,M2,_Col,S1,S2|_Rest2])->    
+    Year=list_to_integer([50,48,Y1,Y2]),
+    Day=list_to_integer([D1,D2]),
+    Month = http_util:convert_month([M,O,N]),
+    Hour=list_to_integer([H1,H2]),
+    Min=list_to_integer([M1,M2]),
+    Sec=list_to_integer([S1,S2]),
+    {ok,{{Year,Month,Day},{Hour,Min,Sec}}}.
+
+convert_ascii_date([_D,_A,_Y,_SP,
+		    M,O,N,_SP,
+		    D1,D2,_SP,
+		    H1,H2,_Col,
+		    M1,M2,_Col,
+		    S1,S2,_SP,
+		    Y1,Y2,Y3,Y4| _Rest])->
+    Year=list_to_integer([Y1,Y2,Y3,Y4]),
+    Day=case D1 of 
+	    $\ ->
+		list_to_integer([D2]);
+	    _->
+		list_to_integer([D1,D2])
+	end,
+    Month=http_util:convert_month([M,O,N]),
+    Hour=list_to_integer([H1,H2]),
+    Min=list_to_integer([M1,M2]),
+    Sec=list_to_integer([S1,S2]),
+    {ok,{{Year,Month,Day},{Hour,Min,Sec}}}.
+
+convert_rfc1123_date([_D,_A,_Y,_C,_SP,
+		      D1,D2,_SP,
+		      M,O,N,_SP,
+		      Y1,Y2,Y3,Y4,_SP,
+		      H1,H2,_Col,
+		      M1,M2,_Col,
+		      S1,S2|_Rest]) -> 
+    Year=list_to_integer([Y1,Y2,Y3,Y4]),
+    Day=list_to_integer([D1,D2]),
+    Month=http_util:convert_month([M,O,N]),
+    Hour=list_to_integer([H1,H2]),
+    Min=list_to_integer([M1,M2]),
+    Sec=list_to_integer([S1,S2]),
+    {ok,{{Year,Month,Day},{Hour,Min,Sec}}}.
+
+convert_netscapecookie_date(Date)->
+    case (catch http_util:convert_netscapecookie_date(Date)) of
+	Ret = {ok, _} ->
+	    Ret;
+	_ ->
+	    {error,bad_date}
+    end.
+
+
+%% rfc1123_date
+
+rfc1123_date() ->
+    {{YYYY,MM,DD},{Hour,Min,Sec}} = calendar:universal_time(),
+    DayNumber = calendar:day_of_the_week({YYYY,MM,DD}),
+    lists:flatten(
+      io_lib:format("~s, ~2.2.0w ~3.s ~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
+		    [day(DayNumber),DD,month(MM),YYYY,Hour,Min,Sec])).
+
+rfc1123_date(undefined) ->
+    undefined;
+rfc1123_date(LocalTime) ->
+    {{YYYY,MM,DD},{Hour,Min,Sec}} = 
+	case calendar:local_time_to_universal_time_dst(LocalTime) of
+	    [Gmt]   -> Gmt;
+	    [_,Gmt] -> Gmt
+	end,
+    DayNumber = calendar:day_of_the_week({YYYY,MM,DD}),
+    lists:flatten(
+      io_lib:format("~s, ~2.2.0w ~3.s ~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
+		    [day(DayNumber),DD,month(MM),YYYY,Hour,Min,Sec])).
+
+%% uniq
+
+uniq([]) ->
+    [];
+uniq([First,First|Rest]) ->
+    uniq([First|Rest]);
+uniq([First|Rest]) ->
+    [First|uniq(Rest)].
+
+
+%% day
+
+day(1) -> "Mon";
+day(2) -> "Tue";
+day(3) -> "Wed";
+day(4) -> "Thu";
+day(5) -> "Fri";
+day(6) -> "Sat"; 
+day(7) -> "Sun".
+
+%% month
+
+month(1) -> "Jan";
+month(2) -> "Feb";
+month(3) -> "Mar";
+month(4) -> "Apr";
+month(5) -> "May";
+month(6) -> "Jun";
+month(7) -> "Jul";
+month(8) -> "Aug";
+month(9) -> "Sep";
+month(10) -> "Oct";
+month(11) -> "Nov";
+month(12) -> "Dec".
+
+%% decode_hex
+
+decode_hex([$%,Hex1,Hex2|Rest]) ->
+    [hex2dec(Hex1)*16+hex2dec(Hex2)|decode_hex(Rest)];
+decode_hex([First|Rest]) ->
+    [First|decode_hex(Rest)];
+decode_hex([]) ->
+    [].
+
+hex2dec(X) when X>=$0,X=<$9 -> X-$0;
+hex2dec(X) when X>=$A,X=<$F -> X-$A+10;
+hex2dec(X) when X>=$a,X=<$f -> X-$a+10.
+
+%% decode_base64 (DEBUG STRING: QWxhZGRpbjpvcGVuIHNlc2FtZQ==)
+
+%%% Base-64 decoding (RFC2045)
+%% Keep for backward compatibility
+decode_base64(Base64) -> 
+    http_base_64:decode(Base64).
+encode_base64(ASCII) -> 
+    http_base_64:encode(ASCII).
+
+%% flatlength
+flatlength(List) ->
+    flatlength(List, 0).
+
+flatlength([H|T],L) when list(H) ->
+    flatlength(H,flatlength(T,L));
+flatlength([H|T],L) when binary(H) ->
+    flatlength(T,L+size(H));
+flatlength([_H|T],L) ->
+    flatlength(T,L+1);
+flatlength([],L) ->
+    L.
+
+%% split_path
+
+split_path(Path) ->
+    case regexp:match(Path,"[\?].*\$") of
+	%% A QUERY_STRING exists!
+	{match,Start,Length} ->
+	    {httpd_util:decode_hex(string:substr(Path,1,Start-1)),
+	     string:substr(Path,Start,Length)};
+	%% A possible PATH_INFO exists!
+	nomatch ->
+	    split_path(Path,[])
+    end.
+
+split_path([],SoFar) ->
+    {httpd_util:decode_hex(lists:reverse(SoFar)),[]};
+split_path([$/|Rest],SoFar) ->
+    Path=httpd_util:decode_hex(lists:reverse(SoFar)),
+    case file:read_file_info(Path) of
+	{ok,FileInfo} when FileInfo#file_info.type == regular ->
+	    {Path,[$/|Rest]};
+	{ok, _FileInfo} ->
+	    split_path(Rest,[$/|SoFar]);
+	{error, _Reason} ->
+	    split_path(Rest,[$/|SoFar])
+    end;
+split_path([C|Rest],SoFar) ->
+    split_path(Rest,[C|SoFar]).
+
+%% split_script_path
+
+split_script_path(Path) ->
+    case split_script_path(Path, []) of
+	{Script, AfterPath} ->
+	    {PathInfo, QueryString} = pathinfo_querystring(AfterPath),
+	    {Script, {PathInfo, QueryString}};
+	not_a_script ->
+	    not_a_script
+    end.
+
+pathinfo_querystring(Str) ->
+    pathinfo_querystring(Str, []).
+pathinfo_querystring([], SoFar) ->
+    {lists:reverse(SoFar), []};
+pathinfo_querystring([$?|Rest], SoFar) ->
+    {lists:reverse(SoFar), Rest};
+pathinfo_querystring([C|Rest], SoFar) ->
+    pathinfo_querystring(Rest, [C|SoFar]).
+
+split_script_path([$?|QueryString], SoFar) ->
+    Path = httpd_util:decode_hex(lists:reverse(SoFar)),
+    case file:read_file_info(Path) of
+	{ok,FileInfo} when FileInfo#file_info.type == regular ->
+	    {Path, [$?|QueryString]};
+	{ok, _FileInfo} ->
+	    not_a_script;
+	{error, _Reason} ->
+	    not_a_script
+    end;
+split_script_path([], SoFar) ->
+    Path = httpd_util:decode_hex(lists:reverse(SoFar)),
+    case file:read_file_info(Path) of
+	{ok,FileInfo} when FileInfo#file_info.type == regular ->
+	    {Path, []};
+	{ok, _FileInfo} ->
+	    not_a_script;
+	{error, _Reason} ->
+	    not_a_script
+    end;
+split_script_path([$/|Rest], SoFar) ->
+    Path = httpd_util:decode_hex(lists:reverse(SoFar)),
+    case file:read_file_info(Path) of
+	{ok, FileInfo} when FileInfo#file_info.type == regular ->
+	    {Path, [$/|Rest]};
+	{ok, _FileInfo} ->
+	    split_script_path(Rest, [$/|SoFar]);
+	{error, _Reason} ->
+	    split_script_path(Rest, [$/|SoFar])
+    end;
+split_script_path([C|Rest], SoFar) ->
+    split_script_path(Rest,[C|SoFar]).
+
+%% suffix
+
+suffix(Path) ->
+    case filename:extension(Path) of
+	[] ->
+	    [];
+	Extension ->
+	    tl(Extension)
+    end.
+
+%% to_upper
+
+to_upper(Str) ->
+    http_util:to_upper(Str).
+
+%% to_lower
+
+to_lower(Str) ->
+    http_util:to_lower(Str).
+
+
+
+%% strip
+strip(Value)->
+    lists:reverse(remove_ws(lists:reverse(remove_ws(Value)))).
+	
+remove_ws([$\s|Rest])->
+    remove_ws(Rest);
+remove_ws([$\t|Rest]) ->
+    remove_ws(Rest);
+remove_ws(Rest) ->
+    Rest.
+
+%% split
+
+split(String,RegExp,Limit) ->
+    case regexp:parse(RegExp) of
+	{error,Reason} ->
+	    {error,Reason};
+	{ok,_} ->
+	    {ok,do_split(String,RegExp,Limit)}
+    end.
+
+do_split(String, _RegExp, 1) ->
+    [String];
+
+do_split(String,RegExp,Limit) ->
+    case regexp:first_match(String,RegExp) of 
+	{match,Start,Length} ->
+	    [string:substr(String,1,Start-1)|
+	     do_split(lists:nthtail(Start+Length-1,String),RegExp,Limit-1)];
+	nomatch ->
+	    [String]
+    end.
+
+%% make_name/2, make_name/3
+%% Prefix  -> string()
+%%            First part of the name, e.g. "httpd"
+%% Addr    -> {A,B,C,D} | string() | undefined
+%%            The address part of the name. 
+%%            e.g. "123.234.55.66" or {123,234,55,66} or "otp.ericsson.se" 
+%%            for a host address or undefined if local host.
+%% Port    -> integer()
+%%            Last part of the name, such as the HTTPD server port 
+%%            number (80).
+%% Postfix -> Any string that will be added last to the name
+%%
+%% Example:
+%% make_name("httpd","otp.ericsson.se",80) => httpd__otp_ericsson_se__80
+%% make_name("httpd",undefined,8088)       => httpd_8088
+
+make_name(Prefix,Port) ->
+    make_name(Prefix,undefined,Port,"").
+
+make_name(Prefix,Addr,Port) ->
+    make_name(Prefix,Addr,Port,"").
+    
+make_name(Prefix,"*",Port,Postfix) ->
+    make_name(Prefix,undefined,Port,Postfix);
+
+make_name(Prefix,any,Port,Postfix) ->
+    make_name1(io_lib:format("~s_~w~s",[Prefix,Port,Postfix]));
+
+make_name(Prefix,undefined,Port,Postfix) ->
+    make_name1(io_lib:format("~s_~w~s",[Prefix,Port,Postfix]));
+
+make_name(Prefix,Addr,Port,Postfix) ->
+    NameString = 
+        Prefix ++ "__" ++ make_name2(Addr) ++ "__" ++ 
+	integer_to_list(Port) ++ Postfix,
+    make_name1(NameString).
+    
+make_name1(String) ->
+    list_to_atom(lists:flatten(String)).
+
+make_name2({A,B,C,D}) ->
+    io_lib:format("~w_~w_~w_~w",[A,B,C,D]);
+
+make_name2({A, B, C, D, E, F, G, H}) ->
+    io_lib:format("~w_~w_~w_~w_~w_~w_~w_~w",[integer_to_hexlist(A),
+					     integer_to_hexlist(B),
+					     integer_to_hexlist(C),
+					     integer_to_hexlist(D),
+					     integer_to_hexlist(E),
+					     integer_to_hexlist(F),
+					     integer_to_hexlist(G),
+					     integer_to_hexlist(H)
+					    ]);
+make_name2(Addr) ->
+    search_and_replace(Addr,$.,$_).
+
+search_and_replace(S,A,B) ->
+    Fun = fun(What) -> 
+                  case What of
+                      A -> B;
+                      O -> O
+                  end
+          end,
+    lists:map(Fun,S).
+
+
+
+%%----------------------------------------------------------------------
+%% Converts  a string that constists of 0-9,A-F,a-f to a 
+%% integer
+%%----------------------------------------------------------------------
+
+hexlist_to_integer(List)->
+    http_util:hexlist_to_integer(List).
+
+%%----------------------------------------------------------------------
+%%Converts an integer to an hexlist
+%%----------------------------------------------------------------------
+encode_hex(Num)->
+    integer_to_hexlist(Num).
+
+integer_to_hexlist(Num) when is_integer(Num) ->
+    http_util:integer_to_hexlist(Num).
+	    	      
+create_etag(FileInfo)->
+    create_etag(FileInfo#file_info.mtime,FileInfo#file_info.size).
+
+create_etag({{Year,Month,Day},{Hour,Min,Sec}},Size)->
+    create_part([Year,Month,Day,Hour,Min,Sec])++io_lib:write(Size);
+
+create_etag(FileInfo,Size)->
+    create_etag(FileInfo#file_info.mtime,Size).
+
+create_part(Values)->
+    lists:map(fun(Val0)->
+		      Val=Val0 rem 60,
+			  if
+			      Val=<25 ->
+				  65+Val;  % A-Z
+			      Val=<50 ->
+				  72+Val;  % a-z
+			      %%Since no date s
+			      true ->
+				  Val-3
+			  end
+	      end,Values).
+
+
+%%----------------------------------------------------------------------
+%% Enable debugging, validate httpd options
+%%----------------------------------------------------------------------
+
+enable_debug([]) ->
+    ok;
+enable_debug(Debug) ->
+    dbg:tracer(),
+    dbg:p(all, [call]),
+    do_enable_debug(Debug).
+
+do_enable_debug(disable) ->
+    dbg:stop();
+do_enable_debug([]) ->
+    ok;
+do_enable_debug([{Level,Modules}|Rest]) when atom(Level),list(Modules) ->
+    case Level of
+	all_functions ->
+	    io:format("Tracing on all functions set on modules: ~p~n",
+		      [Modules]),
+	    lists:foreach(fun(X)->dbg:tpl(X, [{'_', [], [{return_trace}]}]) end,Modules);
+	exported_functions -> 
+	    io:format("Tracing on exported functions set on modules: ~p~n",[Modules]),
+	    lists:foreach(fun(X)->dbg:tp(X, [{'_', [], [{return_trace}]}]) end,Modules);
+	disable ->
+	    io:format("Tracing disabled on modules: ~p~n",[Modules]),
+	    lists:foreach(fun(X)->dbg:ctp(X) end,Modules);
+	_ ->
+	    ok
+    end,
+    do_enable_debug(Rest).
+
+
+
+valid_options(Debug,AcceptTimeout,ConfigFile) ->
+    valid_debug(Debug),
+    valid_accept_timeout(AcceptTimeout),
+    valid_config_file(ConfigFile).
+valid_debug([]) ->
+    ok;
+valid_debug(disable) ->
+    ok;
+valid_debug(L) when list(L) ->
+    valid_debug2(L);
+valid_debug(D) ->
+    throw({error,{bad_debug_option,D}}).
+valid_debug2([{all_functions,L}|Rest]) when list(L) ->
+    test_load_modules(L),
+    valid_debug2(Rest);
+valid_debug2([{exported_functions,L}|Rest]) when list(L) ->
+    test_load_modules(L),
+    valid_debug2(Rest);
+valid_debug2([{disable,L}|Rest]) when list(L) ->
+    test_load_modules(L),
+    valid_debug2(Rest);
+valid_debug2([H|_T]) ->
+    throw({error,{bad_debug_option,H}});
+valid_debug2([]) ->
+    ok.
+valid_accept_timeout(I) when is_integer(I) ->
+    ok;
+valid_accept_timeout(A) ->
+    throw({error,{bad_debug_option,A}}).
+valid_config_file(_) ->
+    ok.
+
+test_load_modules([H|T]) when atom(H) ->
+    case code:which(H) of
+	non_existing ->
+	    throw({error,{module_does_not_exist,H}});
+	_ -> ok
+    end,
+    test_load_modules(T);
+test_load_modules([H|_T]) ->
+    throw({error,{module_name_not_atom,H}});
+test_load_modules([]) ->
+    ok.

Added: incubator/couchdb/trunk/src/couch_inets/inets.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/inets.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/inets.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/inets.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,34 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%% 
+%%     $Id$
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The main interface module of the inets application
+%%----------------------------------------------------------------------
+
+-module(inets).
+
+-export([start/0, start/1, stop/0]).
+
+start() -> 
+    application:start(inets).
+
+start(Type) -> 
+    application:start(inets, Type).
+
+stop() -> 
+    application:stop(inets).
+

Added: incubator/couchdb/trunk/src/couch_inets/inets_app.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/inets_app.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/inets_app.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/inets_app.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,28 @@
+%% ``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(inets_app).
+
+-behaviour(application).
+
+-export([start/2, stop/1]).
+
+start(_Type, _State) ->
+    supervisor:start_link({local, inets_sup}, inets_sup, []).
+
+stop(_State) ->
+    ok.

Added: incubator/couchdb/trunk/src/couch_inets/inets_internal.hrl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/inets_internal.hrl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/inets_internal.hrl (added)
+++ incubator/couchdb/trunk/src/couch_inets/inets_internal.hrl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,27 @@
+%% ``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$
+%%
+
+-define(CR, $\r).
+-define(LF, $\n).
+-define(CRLF, [$\r,$\n]).
+-define(SP, $\s).
+-define(TAB, $\t).
+-define(LEFT_PAREN, $().
+-define(RIGHT_PAREN, $)).
+-define(WHITE_SPACE, $ ).
+-define(DOUBLE_QUOTE, $"). 

Added: incubator/couchdb/trunk/src/couch_inets/inets_sup.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/inets_sup.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/inets_sup.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/inets_sup.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,106 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%% 
+%%     $Id$
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for the inets application
+%%----------------------------------------------------------------------
+
+-module(inets_sup).
+
+-behaviour(supervisor).
+
+-export([init/1]).
+
+%%%=========================================================================
+%%%  Supervisor callback
+%%%=========================================================================
+init([]) ->
+    SupFlags = {one_for_one, 10, 3600},
+    Children = children(), 
+    {ok, {SupFlags, Children}}.
+
+%%%=========================================================================
+%%%  Internal functions
+%%%=========================================================================
+get_services() ->
+    case (catch application:get_env(inets, services)) of
+	{ok, Services} ->
+	    Services;
+	_ ->
+	    []
+    end.
+
+children() ->
+    Services = get_services(),
+    HttpdServices = [Service || Service <- Services, is_httpd(Service)],
+    HttpcServices =  [Service || Service <- Services, is_httpc(Service)],
+    TftpdServices =  [Service || Service <- Services, is_tftpd(Service)],
+    [ftp_child_spec(), httpc_child_spec(HttpcServices), 
+     httpd_child_spec(HttpdServices), tftpd_child_spec(TftpdServices)].
+
+ftp_child_spec() ->
+    Name = ftp_sup,
+    StartFunc = {ftp_sup, start_link, []},
+    Restart = permanent, 
+    Shutdown = infinity,
+    Modules = [ftp_sup],
+    Type = supervisor,
+    {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+httpc_child_spec(HttpcServices) ->
+    Name = httpc_sup,
+    StartFunc = {httpc_sup, start_link, [HttpcServices]},
+    Restart = permanent, 
+    Shutdown = infinity,
+    Modules = [httpc_sup],
+    Type = supervisor,
+    {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+httpd_child_spec(HttpdServices) ->
+    Name = httpd_sup,
+    StartFunc = {httpd_sup, start_link, [HttpdServices]},
+    Restart = permanent, 
+    Shutdown = infinity,
+    Modules = [httpd_sup],
+    Type = supervisor,
+    {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+tftpd_child_spec(TftpServices) ->
+    Name = tftp_sup,
+    StartFunc = {tftp_sup, start_link, [TftpServices]},
+    Restart = permanent, 
+    Shutdown = infinity,
+    Modules = [tftp_sup],
+    Type = supervisor,
+    {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+is_httpd({httpd, _}) ->
+    true;
+is_httpd({httpd, _, _}) ->
+    true;
+is_httpd(_) ->
+    false.
+
+is_httpc({httpc, _}) ->
+    true;
+is_httpc(_) ->
+    false.
+
+is_tftpd({tftpd, _}) ->
+    true;
+is_tftpd(_) ->
+    false.

Added: incubator/couchdb/trunk/src/couch_inets/mod_actions.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_actions.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_actions.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_actions.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,92 @@
+%% ``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_actions).
+-export([do/1,load/2]).
+
+-include("httpd.hrl").
+
+%% do
+
+do(Info) ->
+  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 ->
+	  Path = mod_alias:path(Info#mod.data,Info#mod.config_db,
+			      Info#mod.request_uri),
+	  Suffix = httpd_util:suffix(Path),
+	  MimeType = httpd_util:lookup_mime(Info#mod.config_db,Suffix,
+					  "text/plain"),
+	  Actions = httpd_util:multi_lookup(Info#mod.config_db,action),
+	  case action(Info#mod.request_uri,MimeType,Actions) of
+	    {yes, RequestURI} ->
+	      {proceed, [{new_request_uri, RequestURI} | Info#mod.data]};
+	    no ->
+	      Scripts = httpd_util:multi_lookup(Info#mod.config_db, script),
+	      case script(Info#mod.request_uri, Info#mod.method, Scripts) of
+		{yes, RequestURI} ->
+		  {proceed,[{new_request_uri, RequestURI} | Info#mod.data]};
+		no ->
+		  {proceed, Info#mod.data} 
+	      end
+	  end;
+	%% A response has been generated or sent!
+	_Response ->
+	  {proceed, Info#mod.data}
+      end
+  end.
+
+action(_RequestURI, _MimeType, []) ->
+  no;
+action(RequestURI, MimeType, [{MimeType, CGIScript} | _Rest]) ->
+  {yes, CGIScript ++ RequestURI};
+action(RequestURI, MimeType, [_ | Rest]) ->
+  action(RequestURI, MimeType, Rest).
+
+script(_RequestURI, _Method, []) ->
+  no;
+script(RequestURI, Method, [{Method, CGIScript} | _Rest]) ->
+  {yes, CGIScript ++ RequestURI};
+script(RequestURI, Method, [_ | Rest]) ->
+  script(RequestURI, Method, Rest).
+
+%%
+%% Configuration
+%%
+
+%% load
+
+load("Action "++  Action, []) ->
+  case regexp:split(Action, " ") of
+    {ok,[MimeType, CGIScript]} ->
+      {ok,[],{action, {MimeType, CGIScript}}};
+    {ok,_} ->
+      {error,?NICE(httpd_conf:clean(Action)++" is an invalid Action")}
+  end;
+load("Script " ++ Script,[]) ->
+  case regexp:split(Script, " ") of
+    {ok,[Method, CGIScript]} ->
+      {ok,[],{script, {Method, CGIScript}}};
+    {ok,_} ->
+      {error,?NICE(httpd_conf:clean(Script)++" is an invalid Script")}
+  end.

Added: incubator/couchdb/trunk/src/couch_inets/mod_alias.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_alias.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_alias.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_alias.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,180 @@
+%% ``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_alias).
+
+-export([do/1, 
+	 real_name/3,
+	 real_script_name/3,
+	 default_index/2,
+	 load/2,
+	 path/3]).
+
+-include("httpd.hrl").
+
+-define(VMODULE,"ALIAS").
+
+%% do
+
+do(Info) ->
+    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_alias(Info);
+		%% A response has been generated or sent!
+		_Response ->
+		    {proceed, Info#mod.data}
+	    end
+    end.
+
+do_alias(Info) ->
+    {ShortPath, Path, AfterPath} =
+	real_name(Info#mod.config_db, 
+		  Info#mod.request_uri,
+		  httpd_util:multi_lookup(Info#mod.config_db,alias)),
+    %% Relocate if a trailing slash is missing else proceed!
+    LastChar = lists:last(ShortPath),
+    case file:read_file_info(ShortPath) of 
+	{ok, FileInfo} when FileInfo#file_info.type == directory, 
+	LastChar /= $/ ->
+	    ServerName = httpd_util:lookup(Info#mod.config_db, server_name),
+	    Port = port_string(httpd_util:lookup(Info#mod.config_db,port, 80)),
+	    URL = "http://" ++ ServerName ++ Port ++ 
+		Info#mod.request_uri ++ "/",
+	    ReasonPhrase = httpd_util:reason_phrase(301),
+	    Message = httpd_util:message(301, URL, Info#mod.config_db),
+	    {proceed,
+	     [{response,
+	       {301, ["Location: ", URL, "\r\n"
+		      "Content-Type: text/html\r\n",
+		      "\r\n",
+		      "<HTML>\n<HEAD>\n<TITLE>",ReasonPhrase,
+		      "</TITLE>\n</HEAD>\n"
+		      "<BODY>\n<H1>",ReasonPhrase,
+		      "</H1>\n", Message, 
+		      "\n</BODY>\n</HTML>\n"]}}|
+	      [{real_name, {Path, AfterPath}} | Info#mod.data]]};
+	_NoFile ->
+	    {proceed,[{real_name, {Path, AfterPath}} | Info#mod.data]}
+    end.
+
+port_string(80) ->
+    "";
+port_string(Port) ->
+    ":"++integer_to_list(Port).
+
+%% real_name
+
+real_name(ConfigDB, RequestURI, []) ->
+    DocumentRoot = httpd_util:lookup(ConfigDB, document_root, ""),
+    RealName = DocumentRoot ++ RequestURI,
+    {ShortPath, _AfterPath} = httpd_util:split_path(RealName),
+    {Path, AfterPath} = httpd_util:split_path(default_index(ConfigDB, 
+							    RealName)),
+    {ShortPath, Path, AfterPath};
+real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) ->
+     case regexp:match(RequestURI, "^" ++ FakeName) of
+	{match, _, _} ->
+	    {ok, ActualName, _} = regexp:sub(RequestURI,
+					     "^" ++ FakeName, RealName),
+ 	    {ShortPath, _AfterPath} = httpd_util:split_path(ActualName),
+	    {Path, AfterPath} =
+	       httpd_util:split_path(default_index(ConfigDB, ActualName)),
+	    {ShortPath, Path, AfterPath};
+	 nomatch ->
+	     real_name(ConfigDB,RequestURI,Rest)
+    end.
+
+%% real_script_name
+
+real_script_name(_ConfigDB, _RequestURI, []) ->
+    not_a_script;
+real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) ->
+    case regexp:match(RequestURI,"^"++FakeName) of
+	{match,_,_} ->
+	    {ok,ActualName,_}=regexp:sub(RequestURI,"^"++FakeName,RealName),
+	    httpd_util:split_script_path(default_index(ConfigDB,ActualName));
+	nomatch ->
+	    real_script_name(ConfigDB,RequestURI,Rest)
+    end.
+
+%% default_index
+
+default_index(ConfigDB, Path) ->
+    case file:read_file_info(Path) of
+	{ok, FileInfo} when FileInfo#file_info.type == directory ->
+	    DirectoryIndex = httpd_util:lookup(ConfigDB, directory_index, []),
+	    append_index(Path, DirectoryIndex);
+	_ ->
+	    Path
+    end.
+
+append_index(RealName, []) ->
+    RealName;
+append_index(RealName, [Index | Rest]) ->
+    case file:read_file_info(filename:join(RealName, Index)) of
+	{error, _Reason} ->
+	    append_index(RealName, Rest);
+	_ ->
+	    filename:join(RealName, Index)
+    end.
+
+%% path
+
+path(Data, ConfigDB, RequestURI) ->
+    case httpd_util:key1search(Data, real_name) of
+	undefined ->
+	    DocumentRoot = httpd_util:lookup(ConfigDB, document_root, ""),
+	    {Path, _AfterPath} = 
+		httpd_util:split_path(DocumentRoot++RequestURI),
+	    Path;
+	{Path, _AfterPath} ->
+	    Path
+    end.
+
+%%
+%% Configuration
+%%
+
+%% load
+
+load("DirectoryIndex " ++ DirectoryIndex, []) ->
+    {ok, DirectoryIndexes} = regexp:split(DirectoryIndex," "),
+    {ok,[], {directory_index, DirectoryIndexes}};
+load("Alias " ++ Alias,[]) ->
+    case regexp:split(Alias," ") of
+	{ok, [FakeName, RealName]} ->
+	    {ok,[],{alias,{FakeName,RealName}}};
+	{ok, _} ->
+	    {error,?NICE(httpd_conf:clean(Alias)++" is an invalid Alias")}
+    end;
+load("ScriptAlias " ++ ScriptAlias, []) ->
+    case regexp:split(ScriptAlias, " ") of
+	{ok, [FakeName, RealName]} ->
+	    %% Make sure the path always has a trailing slash..
+	    RealName1 = filename:join(filename:split(RealName)),
+	    {ok, [], {script_alias, {FakeName, RealName1++"/"}}};
+	{ok, _} ->
+	    {error, ?NICE(httpd_conf:clean(ScriptAlias)++
+			  " is an invalid ScriptAlias")}
+    end.

Added: incubator/couchdb/trunk/src/couch_inets/mod_auth.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_auth.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_auth.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_auth.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,784 @@
+%% ``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).
+
+%% The functions that the webbserver call on startup stop
+%% and when the server traverse the modules.
+-export([do/1, load/2, store/2, remove/1]).
+
+%% User entries to the gen-server.
+-export([add_user/2, add_user/5, add_user/6, 
+	 add_group_member/3, add_group_member/4, add_group_member/5, 
+	 list_users/1, list_users/2, list_users/3, 
+	 delete_user/2, delete_user/3, delete_user/4,
+	 delete_group_member/3, delete_group_member/4, delete_group_member/5, 
+	 list_groups/1, list_groups/2, list_groups/3, 
+	 delete_group/2, delete_group/3, delete_group/4,
+	 get_user/2, get_user/3, get_user/4, 
+	 list_group_members/2, list_group_members/3, list_group_members/4,
+	 update_password/6, update_password/5]).
+
+-include("httpd.hrl").
+-include("mod_auth.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,"AUTH").
+
+-define(NOPASSWORD,"NoPassword").
+
+%% do
+do(Info) ->
+    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 ->
+		    Path = mod_alias:path(Info#mod.data,Info#mod.config_db,
+					  Info#mod.request_uri),
+		    %% Is it a secret area?
+		    case secretp(Path,Info#mod.config_db) of
+			{yes, Directory, DirectoryData} ->
+			    %% Authenticate (allow)
+			    case allow((Info#mod.init_data)#init_data.peername,
+				       Info#mod.socket_type,Info#mod.socket,
+				       DirectoryData) of
+				allowed ->
+				    case deny((Info#mod.init_data)#init_data.peername,
+					      Info#mod.socket_type, 
+					      Info#mod.socket,
+					      DirectoryData) of
+					not_denied ->
+					    case httpd_util:key1search(
+						   DirectoryData,
+						   auth_type) of
+						undefined ->
+						    {proceed, Info#mod.data};
+						none ->
+						    {proceed, Info#mod.data};
+						AuthType ->
+						    do_auth(Info, 
+							    Directory, 
+							    DirectoryData,
+							    AuthType)
+					    end;
+					{denied, Reason} ->
+					    {proceed,
+					     [{status, {403,
+						       Info#mod.request_uri,
+						       Reason}}|
+					      Info#mod.data]}
+				    end;
+				{not_allowed, Reason} ->
+				    {proceed,[{status,{403,
+						       Info#mod.request_uri,
+						       Reason}} |
+					      Info#mod.data]}
+			    end;
+			no ->
+			    {proceed, Info#mod.data}
+		    end;
+		%% A response has been generated or sent!
+		_Response ->
+		    {proceed, Info#mod.data}
+	    end
+    end.
+
+
+do_auth(Info, Directory, DirectoryData, _AuthType) ->
+    %% Authenticate (require)
+    case require(Info, Directory, DirectoryData) of
+	authorized ->
+	    {proceed,Info#mod.data};
+	{authorized, User} ->
+	    {proceed, [{remote_user,User}|Info#mod.data]};
+	{authorization_required, Realm} ->
+	    ReasonPhrase = httpd_util:reason_phrase(401),
+	    Message = httpd_util:message(401,none,Info#mod.config_db),
+	    {proceed,
+	     [{response,
+	       {401,
+		["WWW-Authenticate: Basic realm=\"",Realm,
+		 "\"\r\n\r\n","<HTML>\n<HEAD>\n<TITLE>",
+		 ReasonPhrase,"</TITLE>\n",
+		 "</HEAD>\n<BODY>\n<H1>",ReasonPhrase,
+		 "</H1>\n",Message,"\n</BODY>\n</HTML>\n"]}}|
+	      Info#mod.data]};
+	{status, {StatusCode,PhraseArgs,Reason}} ->
+	    {proceed, [{status,{StatusCode,PhraseArgs,Reason}}|
+		       Info#mod.data]}
+    end.
+
+%% require
+
+require(Info, Directory, DirectoryData) ->
+    ParsedHeader = Info#mod.parsed_header,
+    ValidUsers   = httpd_util:key1search(DirectoryData, require_user),
+    ValidGroups  = httpd_util:key1search(DirectoryData, require_group),
+
+    %% Any user or group restrictions?
+    case ValidGroups of
+	undefined when ValidUsers == undefined ->
+	    authorized;
+	_ ->
+	    case httpd_util:key1search(ParsedHeader, "authorization") of
+		undefined ->
+		    authorization_required(DirectoryData);
+		%% Check credentials!
+		"Basic" ++ EncodedString = Credentials ->
+		    case (catch http_base_64:decode(EncodedString)) of
+			{'EXIT',{function_clause, _}} ->
+			    {status, {401, none, ?NICE("Bad credentials "++
+						       Credentials)}};
+			DecodedString ->
+			   validate_user(Info, Directory, DirectoryData,
+					 ValidUsers, ValidGroups, 
+					 DecodedString)
+		    end;
+		%% Bad credentials!
+		BadCredentials ->
+		    {status, {401, none, ?NICE("Bad credentials "++
+					       BadCredentials)}}
+	    end
+    end.
+
+authorization_required(DirectoryData) ->
+    case httpd_util:key1search(DirectoryData, auth_name) of
+	undefined ->
+	    {status,{500, none,?NICE("AuthName directive not specified")}};
+	Realm ->
+	    {authorization_required, Realm}
+    end.
+
+
+validate_user(Info, Directory, DirectoryData, ValidUsers, 
+	      ValidGroups, DecodedString) ->
+    case a_valid_user(Info, DecodedString, 
+		      ValidUsers, ValidGroups, 
+		      Directory, DirectoryData) of
+	{yes, User} ->
+	    {authorized, User};
+	{no, _Reason} ->
+	    authorization_required(DirectoryData);
+	{status, {StatusCode,PhraseArgs,Reason}} ->
+	    {status,{StatusCode,PhraseArgs,Reason}}
+    end.
+
+a_valid_user(Info,DecodedString,ValidUsers,ValidGroups,Dir,DirData) ->
+    case httpd_util:split(DecodedString,":",2) of
+	{ok,[SupposedUser, Password]} ->
+	    case user_accepted(SupposedUser, ValidUsers) of
+		true ->
+		    check_password(SupposedUser, Password, Dir, DirData);
+		false ->
+		    case group_accepted(Info,SupposedUser,
+					ValidGroups,Dir,DirData) of
+			true ->
+			    check_password(SupposedUser,Password,Dir,DirData);
+			false ->
+			    {no,?NICE("No such user exists")}
+		    end
+	    end;
+	{ok,BadCredentials} ->
+	    {status,{401,none,?NICE("Bad credentials "++BadCredentials)}}
+    end.
+
+user_accepted(_SupposedUser, undefined) ->
+    false;
+user_accepted(SupposedUser, ValidUsers) ->
+    lists:member(SupposedUser, ValidUsers).
+
+
+group_accepted(_Info, _User, undefined, _Dir, _DirData) ->
+    false;
+group_accepted(_Info, _User, [], _Dir, _DirData) ->
+    false;
+group_accepted(Info, User, [Group|Rest], Dir, DirData) ->
+    Ret = int_list_group_members(Group, Dir, DirData),
+    case Ret of
+	{ok, UserList} ->
+	    case lists:member(User, UserList) of
+		true ->
+		    true;
+		false ->
+		    group_accepted(Info, User, Rest, Dir, DirData)
+	    end;
+	_ ->
+	    false
+    end.
+
+check_password(User, Password, _Dir, DirData) ->
+    case int_get_user(DirData, User) of
+	{ok, UStruct} ->
+	    case UStruct#httpd_user.password of
+		Password ->
+		    %% FIXME
+		    {yes, UStruct#httpd_user.username};
+		_ ->
+		    {no, "No such user"}   % Don't say 'Bad Password' !!!
+	    end;
+	_ ->
+	    {no, "No such user"}
+    end.
+
+
+%% Middle API. Theese functions call the appropriate authentication module.
+int_get_user(DirData, User) ->    
+    AuthMod = auth_mod_name(DirData), 
+    apply(AuthMod, get_user, [DirData, User]).
+
+int_list_group_members(Group, _Dir, DirData) ->
+    AuthMod = auth_mod_name(DirData),
+    apply(AuthMod, list_group_members, [DirData, Group]).
+
+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.
+
+    
+%%
+%% Is it a secret area?
+%%
+
+%% secretp
+
+secretp(Path,ConfigDB) ->
+    Directories = ets:match(ConfigDB,{directory,'$1','_'}),
+    case secret_path(Path, Directories) of
+	{yes,Directory} ->
+	    {yes,Directory,
+	     lists:flatten(ets:match(ConfigDB,{directory,Directory,'$1'}))};
+	no ->
+	    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, _, _Length} ->
+	    secret_path(Path, Rest, Directory);
+	nomatch ->
+	    secret_path(Path, Rest, Directory)
+    end.
+
+%%
+%% Authenticate
+%%
+
+%% allow
+
+allow({_,RemoteAddr}, _SocketType, _Socket, DirectoryData) ->
+    Hosts = httpd_util:key1search(DirectoryData, allow_from, all),
+    case validate_addr(RemoteAddr, Hosts) of
+	true ->
+	    allowed;
+	false ->
+	    {not_allowed, ?NICE("Connection from your host is not allowed")}
+    end.
+
+validate_addr(_RemoteAddr, all) ->            % When called from 'allow'
+    true;
+validate_addr(_RemoteAddr, none) ->           % When called from 'deny'
+    false;
+validate_addr(_RemoteAddr, []) ->
+    false;
+validate_addr(RemoteAddr, [HostRegExp | Rest]) ->
+    case regexp:match(RemoteAddr, HostRegExp) of
+	{match,_,_} ->
+	    true;
+	nomatch ->
+	    validate_addr(RemoteAddr,Rest)
+    end.
+
+%% deny
+
+deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) ->
+    Hosts = httpd_util:key1search(DirectoryData, deny_from, none),
+    case validate_addr(RemoteAddr,Hosts) of
+	true ->
+	    {denied, ?NICE("Connection from your host is not allowed")};
+	false ->
+	    not_denied
+    end.    
+
+%%
+%% Configuration
+%%
+
+%% load/2
+%%
+
+%% mod_auth recognizes the following Configuration Directives:
+%% <Directory /path/to/directory>
+%%  AuthDBType
+%%  AuthName
+%%  AuthUserFile
+%%  AuthGroupFile
+%%  AuthAccessPassword
+%%  require
+%%  allow
+%% </Directory>
+
+%% When a <Directory> directive is found, a new context is set to
+%% [{directory, Directory, DirData}|OtherContext]
+%% DirData in this case is a key-value list of data belonging to the
+%% directory in question.
+%%
+%% When the </Directory> statement is found, the Context created earlier
+%% will be returned as a ConfigList and the context will return to the
+%% state it was previously.
+
+load("<Directory " ++ Directory,[]) ->
+    Dir = httpd_conf:custom_clean(Directory,"",">"),
+    {ok,[{directory, Dir, [{path, Dir}]}]};
+load(eof,[{directory, Directory, _DirData}|_]) ->
+    {error, ?NICE("Premature end-of-file in "++ Directory)};
+
+load("AuthName " ++ AuthName, [{directory,Directory, DirData}|Rest]) ->
+    {ok, [{directory,Directory,
+	   [ {auth_name, httpd_conf:clean(AuthName)}|DirData]} | Rest ]};
+
+load("AuthUserFile " ++ AuthUserFile0,
+     [{directory, Directory, DirData}|Rest]) ->
+    AuthUserFile = httpd_conf:clean(AuthUserFile0),
+    {ok,[{directory,Directory,
+	  [ {auth_user_file, AuthUserFile}|DirData]} | Rest ]};
+
+load([$A,$u,$t,$h,$G,$r,$o,$u,$p,$F,$i,$l,$e,$ |AuthGroupFile0],
+	 [{directory,Directory, DirData}|Rest]) ->
+    AuthGroupFile = httpd_conf:clean(AuthGroupFile0),
+    {ok,[{directory,Directory,
+	  [ {auth_group_file, AuthGroupFile}|DirData]} | Rest]};
+
+%AuthAccessPassword
+load("AuthAccessPassword " ++ AuthAccessPassword0,
+	 [{directory,Directory, DirData}|Rest]) ->
+    AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0),
+    {ok,[{directory,Directory,
+	  [{auth_access_password, AuthAccessPassword}|DirData]} | Rest]};
+
+
+
+
+load("AuthDBType " ++ Type,
+	 [{directory, Dir, DirData}|Rest]) ->
+    case httpd_conf:clean(Type) of
+	"plain" ->
+	    {ok, [{directory, Dir, [{auth_type, plain}|DirData]} | Rest ]};
+	"mnesia" ->
+	    {ok, [{directory, Dir, [{auth_type, mnesia}|DirData]} | Rest ]};
+	"dets" ->
+	    {ok, [{directory, Dir, [{auth_type, dets}|DirData]} | Rest ]};
+	_ ->
+	    {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")}
+    end;
+
+load("require " ++ Require,[{directory,Directory, DirData}|Rest]) ->
+    case regexp:split(Require," ") of
+	{ok,["user"|Users]} ->
+	    {ok,[{directory,Directory,
+		  [{require_user,Users}|DirData]} | Rest]};
+	{ok,["group"|Groups]} ->
+	    {ok,[{directory,Directory,
+		  [{require_group,Groups}|DirData]} | Rest]};
+	{ok,_} ->
+	    {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")}
+    end;
+
+load("allow " ++ Allow,[{directory,Directory, DirData}|Rest]) ->
+    case regexp:split(Allow," ") of
+	{ok,["from","all"]} ->
+	    {ok,[{directory,Directory,
+		  [{allow_from,all}|DirData]} | Rest]};
+	{ok,["from"|Hosts]} ->
+	    {ok,[{directory,Directory,
+		  [{allow_from,Hosts}|DirData]} | Rest]};
+	{ok,_} ->
+	    {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")}
+    end;
+
+load("deny " ++ Deny,[{directory,Directory, DirData}|Rest]) ->
+    case regexp:split(Deny," ") of
+	{ok, ["from", "all"]} ->
+	    {ok,[{directory, Directory,
+		  [{deny_from, all}|DirData]} | Rest]};
+	{ok, ["from"|Hosts]} ->
+	    {ok,[{directory, Directory,
+		  [{deny_from, Hosts}|DirData]} | Rest]};
+	{ok, _} ->
+	    {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")}
+    end;
+
+load("</Directory>",[{directory,Directory, DirData}|Rest]) -> 
+    directory_config_check(Directory, DirData),
+    {ok, Rest, {directory, Directory, DirData}};
+
+load("AuthMnesiaDB " ++ AuthMnesiaDB,
+      [{directory, Dir, DirData}|Rest]) ->
+    case httpd_conf:clean(AuthMnesiaDB) of
+	"On" ->
+	    {ok,[{directory,Dir,[{auth_type,mnesia}|DirData]}|Rest]};
+	"Off" ->
+	    {ok,[{directory,Dir,[{auth_type,plain}|DirData]}|Rest]};
+	_ ->
+	    {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++
+			  " is an invalid AuthMnesiaDB")}
+    end.
+
+directory_config_check(Directory, DirData) ->
+    case httpd_util:key1search(DirData,auth_type) of
+	plain ->
+	    check_filename_present(Directory,auth_user_file,DirData),
+	    check_filename_present(Directory,auth_group_file,DirData);
+	undefined ->
+	    throw({error,
+		   ?NICE("Server configuration missed AuthDBType directive")});
+	_ ->
+	    ok
+    end.
+check_filename_present(_Dir,AuthFile,DirData) ->
+    case httpd_util:key1search(DirData,AuthFile) of
+	Name when list(Name) ->
+	    ok;
+	_ ->
+	    throw({error,?NICE("Server configuration missed "++
+			       directive(AuthFile)++" directive")})
+    end.
+
+directive(auth_user_file) ->
+    "AuthUserFile";
+directive(auth_group_file) ->
+    "AuthGroupFile".
+
+%% store
+
+store({directory,Directory0, DirData0}, ConfigList) ->
+    Port = httpd_util:key1search(ConfigList, port),
+    DirData = case httpd_util:key1search(ConfigList, bind_address) of
+		  undefined ->
+		      [{port, Port}|DirData0];
+		  Addr ->
+		      [{port, Port},{bind_address,Addr}|DirData0]
+	      end,
+    Directory = 
+	case filename:pathtype(Directory0) of
+	    relative ->
+		SR = httpd_util:key1search(ConfigList, server_root),
+		filename:join(SR, Directory0);
+	    _ ->
+		Directory0
+	end,
+    AuthMod =
+	case httpd_util:key1search(DirData0, auth_type) of
+	    mnesia -> mod_auth_mnesia;
+	    dets ->   mod_auth_dets;
+	    plain ->  mod_auth_plain;
+	    _ ->      no_module_at_all
+	end,
+    case AuthMod of
+	no_module_at_all ->
+	    {ok, {directory, Directory, DirData}};
+	_ ->
+	    %% Control that there are a password or add a standard password: 
+	    %% "NoPassword"
+	    %% In this way a user must select to use a noPassword
+	    Pwd = case httpd_util:key1search(DirData,auth_access_password)of
+		      undefined->
+			  ?NOPASSWORD;
+		      PassW->
+			  PassW
+		  end,
+	    DirDataLast = lists:keydelete(auth_access_password,1,DirData), 
+	    case catch AuthMod:store_directory_data(Directory, DirDataLast) of
+		ok ->
+		    add_auth_password(Directory,Pwd,ConfigList),
+		    {ok, {directory, Directory, DirDataLast}};
+		{ok, NewDirData} ->
+		    add_auth_password(Directory,Pwd,ConfigList),
+		    {ok, {directory, Directory, NewDirData}};
+		{error, Reason} ->
+		    {error, Reason};
+		Other ->
+		    {error, Other}
+	    end
+    end.
+
+
+add_auth_password(Dir, Pwd0, ConfigList) ->    
+    Addr = httpd_util:key1search(ConfigList, bind_address),
+    Port = httpd_util:key1search(ConfigList, port),
+    mod_auth_server:start(Addr, Port),
+    mod_auth_server:add_password(Addr, Port, Dir, Pwd0).
+    
+%% remove
+
+
+remove(ConfigDB) ->
+    lists:foreach(fun({directory, _Dir, DirData}) -> 
+			  AuthMod = auth_mod_name(DirData),
+			  (catch apply(AuthMod, remove, [DirData]))
+		  end,
+		  ets:match_object(ConfigDB,{directory,'_','_'})),
+    Addr = case lookup(ConfigDB, bind_address) of
+	       [] -> 
+		   undefined;
+	       [{bind_address, Address}] ->
+		   Address
+	   end,
+    [{port, Port}] = lookup(ConfigDB, port),
+    mod_auth_server:stop(Addr, Port),
+    ok.
+
+
+
+
+%% --------------------------------------------------------------------
+
+%% update_password
+
+update_password(Port, Dir, Old, New, New)->
+    update_password(undefined, Port, Dir, Old, New, New).
+
+update_password(Addr, Port, Dir, Old, New, New) when list(New) ->
+    mod_auth_server:update_password(Addr, Port, Dir, Old, New);
+
+update_password(_Addr, _Port, _Dir, _Old, _New, _New) ->
+    {error, badtype};
+update_password(_Addr, _Port, _Dir, _Old, _New, _New1) ->
+    {error, notqeual}.
+
+
+%% add_user
+
+add_user(UserName, Opt) ->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd}->
+	    case get_options(Opt, userData) of
+		{error, Reason}->
+		    {error, Reason};
+		{UserData, Password}->
+		    User = [#httpd_user{username  = UserName, 
+					password  = Password,
+					user_data = UserData}],
+		    mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd)
+	    end
+    end.
+
+
+add_user(UserName, Password, UserData, Port, Dir) ->
+    add_user(UserName, Password, UserData, undefined, Port, Dir).
+add_user(UserName, Password, UserData, Addr, Port, Dir) ->
+    User = [#httpd_user{username  = UserName, 
+			password  = Password,
+			user_data = UserData}],
+    mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD).
+
+
+%% get_user
+
+get_user(UserName, Opt) ->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd} ->
+	    mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+
+get_user(UserName, Port, Dir) ->
+    get_user(UserName, undefined, Port, Dir).
+get_user(UserName, Addr, Port, Dir) ->
+    mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD).
+
+
+%% add_group_member
+
+add_group_member(GroupName, UserName, Opt)->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd}->
+	    mod_auth_server:add_group_member(Addr, Port, Dir, 
+					     GroupName, UserName, AuthPwd);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+
+add_group_member(GroupName, UserName, Port, Dir) ->
+    add_group_member(GroupName, UserName, undefined, Port, Dir).
+
+add_group_member(GroupName, UserName, Addr, Port, Dir) ->
+    mod_auth_server:add_group_member(Addr, Port, Dir, 
+				     GroupName, UserName, ?NOPASSWORD).
+
+
+%% delete_group_member
+
+delete_group_member(GroupName, UserName, Opt) ->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd} ->
+	    mod_auth_server:delete_group_member(Addr, Port, Dir, 
+						GroupName, UserName, AuthPwd);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+
+delete_group_member(GroupName, UserName, Port, Dir) ->
+    delete_group_member(GroupName, UserName, undefined, Port, Dir).
+delete_group_member(GroupName, UserName, Addr, Port, Dir) ->
+    mod_auth_server:delete_group_member(Addr, Port, Dir, 
+					GroupName, UserName, ?NOPASSWORD).
+
+
+%% list_users
+
+list_users(Opt) ->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd} ->
+	    mod_auth_server:list_users(Addr, Port, Dir, AuthPwd);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+
+list_users(Port, Dir) ->
+    list_users(undefined, Port, Dir).
+list_users(Addr, Port, Dir) ->
+    mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD).
+
+    
+%% delete_user
+
+delete_user(UserName, Opt) ->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd} ->
+	    mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+
+delete_user(UserName, Port, Dir) ->
+    delete_user(UserName, undefined, Port, Dir).
+delete_user(UserName, Addr, Port, Dir) ->
+    mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD).
+	  
+
+%% delete_group
+
+delete_group(GroupName, Opt) ->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd}->
+	    mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+
+delete_group(GroupName, Port, Dir) ->
+    delete_group(GroupName, undefined, Port, Dir).
+delete_group(GroupName, Addr, Port, Dir) ->
+    mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD).
+
+
+%% list_groups
+
+list_groups(Opt) ->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd}->
+	    mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+
+list_groups(Port, Dir) ->
+    list_groups(undefined, Port, Dir).
+list_groups(Addr, Port, Dir) ->
+    mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD).
+
+
+%% list_group_members
+
+list_group_members(GroupName,Opt) ->
+    case get_options(Opt, mandatory) of
+	{Addr, Port, Dir, AuthPwd} ->
+	    mod_auth_server:list_group_members(Addr, Port, Dir, GroupName, 
+					       AuthPwd);
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+
+list_group_members(GroupName, Port, Dir) ->
+    list_group_members(GroupName, undefined, Port, Dir).
+list_group_members(GroupName, Addr, Port, Dir) ->
+    mod_auth_server:list_group_members(Addr, Port, Dir, 
+				       GroupName, ?NOPASSWORD).
+
+%% Opt = [{port, Port},
+%%        {addr, Addr},
+%%        {dir,  Dir},
+%%        {authPassword, AuthPassword} | FunctionSpecificData]
+get_options(Opt, mandatory)->    
+    case httpd_util:key1search(Opt, port, undefined) of
+	Port when integer(Port) ->
+	    case httpd_util:key1search(Opt, dir, undefined) of
+		Dir when list(Dir) ->
+		    Addr = httpd_util:key1search(Opt,
+						 addr,
+						 undefined),
+		    AuthPwd = httpd_util:key1search(Opt,
+						    authPassword,
+						    ?NOPASSWORD),
+		    {Addr, Port, Dir, AuthPwd};
+		_->
+		    {error, bad_dir}
+	    end;
+	_ ->
+	    {error, bad_dir}
+    end;
+
+%% FunctionSpecificData = {userData, UserData} | {password, Password}
+get_options(Opt, userData)->
+    case httpd_util:key1search(Opt, userData, undefined) of
+	undefined ->
+	    {error, no_userdata};
+	UserData ->
+	    case httpd_util:key1search(Opt, password, undefined) of
+		undefined->
+		    {error, no_password};
+		Pwd ->
+		    {UserData, Pwd}
+	    end
+    end.
+
+
+lookup(Db, Key) ->
+    ets:lookup(Db, Key).

Added: incubator/couchdb/trunk/src/couch_inets/mod_auth.hrl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_auth.hrl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_auth.hrl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_auth.hrl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,27 @@
+%% ``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$
+%%
+
+-record(httpd_user,
+	{username,
+	 password,
+	 user_data}).
+
+-record(httpd_group,
+	{name,
+	 userlist}).
+	  

Added: incubator/couchdb/trunk/src/couch_inets/mod_auth_dets.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_auth_dets.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_auth_dets.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_auth_dets.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,228 @@
+%% ``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_dets).
+
+%% dets authentication storage
+
+-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]).
+
+-export([store_directory_data/2]).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+store_directory_data(_Directory, DirData) ->
+    ?CDEBUG("store_directory_data -> ~n"
+	    "     Directory: ~p~n"
+	    "     DirData:   ~p",
+	    [_Directory, DirData]),
+
+    PWFile = httpd_util:key1search(DirData, auth_user_file),
+    GroupFile = httpd_util:key1search(DirData, auth_group_file),
+    Addr = httpd_util:key1search(DirData, bind_address),
+    Port = httpd_util:key1search(DirData, port),
+
+    PWName  = httpd_util:make_name("httpd_dets_pwdb",Addr,Port),
+    case dets:open_file(PWName,[{type,set},{file,PWFile},{repair,true}]) of
+	{ok, PWDB} ->
+	    GDBName = httpd_util:make_name("httpd_dets_groupdb",Addr,Port),
+	    case dets:open_file(GDBName,[{type,set},{file,GroupFile},{repair,true}]) of
+		{ok, GDB} ->
+		    NDD1 = lists:keyreplace(auth_user_file, 1, DirData, 
+					    {auth_user_file, PWDB}),
+		    NDD2 = lists:keyreplace(auth_group_file, 1, NDD1, 
+					    {auth_group_file, GDB}),
+		    {ok, NDD2};
+		{error, Err}->
+		    {error, {{file, GroupFile},Err}}
+	    end;
+	{error, Err2} ->
+	    {error, {{file, PWFile},Err2}} 
+    end.
+
+%%
+%% Storage format of users in the dets table:
+%% {{UserName, Addr, Port, Dir}, Password, UserData}
+%%
+
+add_user(DirData, UStruct) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    Record = {{UStruct#httpd_user.username, Addr, Port, Dir},
+	      UStruct#httpd_user.password, UStruct#httpd_user.user_data}, 
+    case dets:lookup(PWDB, UStruct#httpd_user.username) of
+	[Record] ->
+	    {error, user_already_in_db};
+	_ ->
+	    dets:insert(PWDB, Record),
+	    true
+    end.
+
+get_user(DirData, UserName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    User = {UserName, Addr, Port, Dir},
+    case dets:lookup(PWDB, User) of
+	[{User, Password, UserData}] ->
+	    {ok, #httpd_user{username=UserName, password=Password, user_data=UserData}};
+	_ ->
+	    {error, no_such_user}
+    end.
+
+list_users(DirData) ->
+    ?DEBUG("list_users -> ~n"
+	   "     DirData: ~p", [DirData]),
+    {Addr, Port, Dir} = lookup_common(DirData),
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    case dets:traverse(PWDB, fun(X) -> {continue, X} end) of    %% SOOOO Ugly !
+	Records when list(Records) ->
+	    ?DEBUG("list_users -> ~n"
+		   "     Records: ~p", [Records]),
+	    {ok, [UserName || {{UserName, AnyAddr, AnyPort, AnyDir}, 
+			       _Password, _Data} <- Records,
+			      AnyAddr == Addr, AnyPort == Port, 
+			      AnyDir == Dir]};
+	_O ->
+	    ?DEBUG("list_users -> ~n"
+		   "     O: ~p", [_O]),
+	    {ok, []}
+    end.
+
+delete_user(DirData, UserName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    User = {UserName, Addr, Port, Dir},
+    case dets:lookup(PWDB, User) of
+	[{User, _SomePassword, _UserData}] ->
+	    dets:delete(PWDB, User),
+	    {ok, Groups} = list_groups(DirData),
+	    lists:foreach(fun(Group) -> 
+				  delete_group_member(DirData, 
+						      Group, UserName) end, 
+			  Groups),
+	    true;
+	_ ->
+	    {error, no_such_user}
+    end.
+
+%%
+%% Storage of groups in the dets table:
+%% {Group, UserList} where UserList is a list of strings.
+%%
+add_group_member(DirData, GroupName, UserName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    Group = {GroupName, Addr, Port, Dir},
+    case dets:lookup(GDB, Group) of
+	[{Group, Users}] ->
+	    case lists:member(UserName, Users) of
+		true ->
+		    true;
+		false ->
+		    dets:insert(GDB, {Group, [UserName|Users]}),
+		    true
+	    end;
+	[] ->
+	    dets:insert(GDB, {Group, [UserName]}),
+	    true;
+	Other ->
+	    {error, Other}
+    end.
+
+list_group_members(DirData, GroupName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    Group = {GroupName, Addr, Port, Dir},
+    case dets:lookup(GDB, Group) of
+	[{Group, Users}] ->
+	    {ok, Users};
+	_ ->
+	    {error, no_such_group}
+    end.
+
+list_groups(DirData) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    GDB  = httpd_util:key1search(DirData, auth_group_file),
+    case dets:match(GDB, {'$1', '_'}) of
+	[] ->
+	    {ok, []};
+	List when list(List) ->
+	    Groups = lists:flatten(List),
+	    {ok, [GroupName || 
+		     {GroupName, AnyAddr, AnyPort, AnyDir} <- Groups,
+		     AnyAddr == Addr, AnyPort == Port, AnyDir == Dir]};
+	_ ->
+	    {ok, []}
+    end.
+
+delete_group_member(DirData, GroupName, UserName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    Group = {GroupName, Addr, Port, Dir},
+    case dets:lookup(GDB, GroupName) of
+	[{Group, Users}] ->
+	    case lists:member(UserName, Users) of
+		true ->
+		    dets:delete(GDB, Group),
+		    dets:insert(GDB, {Group,
+				      lists:delete(UserName, Users)}),
+		    true;
+		false ->
+		    {error, no_such_group_member}
+	    end;
+	_ ->
+	    {error, no_such_group}
+    end.
+
+delete_group(DirData, GroupName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    Group = {GroupName, Addr, Port, Dir},
+    case dets:lookup(GDB, Group) of
+	[{Group, _Users}] ->
+	    dets:delete(GDB, Group),
+	    true;
+	_ ->
+	    {error, no_such_group}
+    end.
+
+lookup_common(DirData) ->
+    Dir  = httpd_util:key1search(DirData, path),
+    Port = httpd_util:key1search(DirData, port),
+    Addr = httpd_util:key1search(DirData, bind_address),
+    {Addr, Port, Dir}.
+
+%% remove/1
+%%
+%% Closes dets tables used by this auth mod.
+%%
+remove(DirData) ->
+    PWDB = httpd_util:key1search(DirData, auth_user_file),
+    GDB = httpd_util:key1search(DirData, auth_group_file),
+    dets:close(GDB),
+    dets:close(PWDB),
+    ok.

Added: incubator/couchdb/trunk/src/couch_inets/mod_auth_mnesia.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/mod_auth_mnesia.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/mod_auth_mnesia.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/mod_auth_mnesia.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,282 @@
+%% ``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_mnesia).
+-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]).
+
+-export([store_user/5, store_user/6, 
+	 store_group_member/5, store_group_member/6, 
+	 list_group_members/3, list_group_members/4, 
+	 list_groups/2, list_groups/3,
+	 list_users/2, list_users/3, 
+	 remove_user/4, remove_user/5, 
+	 remove_group_member/5, remove_group_member/6, 
+	 remove_group/4, remove_group/5]).
+
+-export([store_directory_data/2]).
+
+-include("httpd.hrl").
+-include("mod_auth.hrl").
+
+
+
+store_directory_data(_Directory, _DirData) ->
+    %% We don't need to do anything here, we could of course check that
+    %% the appropriate mnesia tables has been created prior to
+    %% starting the http server.
+    ok.
+
+
+%%
+%% API
+%%
+
+%% Compability API
+
+store_user(UserName, Password, Port, Dir, _AccessPassword) ->
+   %% AccessPassword is ignored - was not used in previous version
+   DirData = [{path,Dir},{port,Port}],
+   UStruct = #httpd_user{username = UserName,
+			 password = Password},
+   add_user(DirData, UStruct).
+
+store_user(UserName, Password, Addr, Port, Dir, _AccessPassword) ->
+   %% AccessPassword is ignored - was not used in previous version
+   DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+   UStruct = #httpd_user{username = UserName,
+			 password = Password},
+   add_user(DirData, UStruct).
+
+store_group_member(GroupName, UserName, Port, Dir, _AccessPassword) ->
+   DirData = [{path,Dir},{port,Port}],
+   add_group_member(DirData, GroupName, UserName).
+
+store_group_member(GroupName, UserName, Addr, Port, Dir, _AccessPassword) ->
+   DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+   add_group_member(DirData, GroupName, UserName).
+
+list_group_members(GroupName, Port, Dir) ->
+   DirData = [{path,Dir},{port,Port}],
+   list_group_members(DirData, GroupName).
+
+list_group_members(GroupName, Addr, Port, Dir) ->
+   DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+   list_group_members(DirData, GroupName).
+
+list_groups(Port, Dir) ->
+   DirData = [{path,Dir},{port,Port}],
+   list_groups(DirData).
+
+list_groups(Addr, Port, Dir) ->
+   DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+   list_groups(DirData).
+
+list_users(Port, Dir) ->
+   DirData = [{path,Dir},{port,Port}],
+   list_users(DirData).
+    
+list_users(Addr, Port, Dir) ->
+   DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+   list_users(DirData).
+    
+remove_user(UserName, Port, Dir, _AccessPassword) ->
+   DirData = [{path,Dir},{port,Port}],
+   delete_user(DirData, UserName).
+
+remove_user(UserName, Addr, Port, Dir, _AccessPassword) ->
+   DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+   delete_user(DirData, UserName).
+
+remove_group_member(GroupName,UserName,Port,Dir,_AccessPassword) ->
+   DirData = [{path,Dir},{port,Port}],
+   delete_group_member(DirData, GroupName, UserName).
+
+remove_group_member(GroupName,UserName,Addr,Port,Dir,_AccessPassword) ->
+   DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+   delete_group_member(DirData, GroupName, UserName).
+
+remove_group(GroupName,Port,Dir,_AccessPassword) ->
+   DirData = [{path,Dir},{port,Port}],
+   delete_group(DirData, GroupName).
+
+remove_group(GroupName,Addr,Port,Dir,_AccessPassword) ->
+   DirData = [{path,Dir},{bind_address,Addr},{port,Port}],
+   delete_group(DirData, GroupName).
+
+%%
+%% Storage format of users in the mnesia table:
+%% httpd_user records
+%%
+
+add_user(DirData, UStruct) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    UserName = UStruct#httpd_user.username,
+    Password = UStruct#httpd_user.password,
+    Data     = UStruct#httpd_user.user_data,
+    User=#httpd_user{username={UserName,Addr,Port,Dir},
+		     password=Password,
+		     user_data=Data},
+    case mnesia:transaction(fun() -> mnesia:write(User) end) of
+	{aborted,Reason} ->
+	    {error,Reason};
+	_ ->
+	    true
+    end.
+
+get_user(DirData, UserName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    case mnesia:transaction(fun() ->
+				    mnesia:read({httpd_user, 
+						 {UserName,Addr,Port,Dir}})
+			    end) of
+	{aborted,Reason} ->
+	    {error, Reason};
+	{atomic,[]} ->
+	    {error, no_such_user};
+	{atomic, [Record]} when record(Record, httpd_user) ->
+	    {ok, Record#httpd_user{username=UserName}};
+	_ ->
+	    {error, no_such_user}
+    end.
+
+list_users(DirData) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    case mnesia:transaction(fun() ->
+				    mnesia:match_object({httpd_user,
+							 {'_',Addr,Port,Dir},'_','_'})
+			    end) of
+	{aborted,Reason} ->
+	    {error,Reason};
+	{atomic,Users} ->
+	    {ok, 
+	     lists:foldr(fun({httpd_user, 
+			      {UserName, _AnyAddr, _AnyPort, _AnyDir}, 
+			      _Password, _Data}, Acc) ->
+				 [UserName|Acc]
+			 end,
+			 [], Users)}
+    end.
+
+delete_user(DirData, UserName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    case mnesia:transaction(fun() ->
+				    mnesia:delete({httpd_user,
+						   {UserName,Addr,Port,Dir}})
+			    end) of
+	{aborted,Reason} ->
+	    {error,Reason};
+	_ ->
+	    true
+    end.
+
+%%
+%% Storage of groups in the mnesia table:
+%% Multiple instances of {#httpd_group, User}
+%%
+
+add_group_member(DirData, GroupName, User) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    Group=#httpd_group{name={GroupName, Addr, Port, Dir}, userlist=User},
+    case mnesia:transaction(fun() -> mnesia:write(Group) end) of
+	{aborted,Reason} ->
+	    {error,Reason};
+	_ ->
+	    true
+    end.
+
+list_group_members(DirData, GroupName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    case mnesia:transaction(fun() ->
+				    mnesia:read({httpd_group,
+						 {GroupName,Addr,Port,Dir}})
+			    end) of
+	{aborted, Reason} ->
+	    {error,Reason};
+	{atomic, Members} ->
+	    {ok,[UserName || {httpd_group,{AnyGroupName,AnyAddr,
+					   AnyPort,AnyDir},UserName} 
+				 <- Members,
+			     AnyGroupName == GroupName, AnyAddr == Addr,
+			     AnyPort == Port, AnyDir == Dir]}
+    end.
+
+list_groups(DirData) -> 
+    {Addr, Port, Dir} = lookup_common(DirData),
+    case mnesia:transaction(fun() ->
+				    mnesia:match_object({httpd_group,
+							 {'_',Addr,Port,Dir},
+							 '_'}) 
+			    end) of
+	{aborted, Reason} ->
+	    {error, Reason};
+	{atomic, Groups} ->
+	    GroupNames=
+		[GroupName || {httpd_group,{GroupName,AnyAddr,AnyPort,AnyDir},
+			       _UserName} <- Groups,
+			      AnyAddr == Addr, AnyPort == AnyPort, 
+			      AnyDir == Dir],
+	    {ok, httpd_util:uniq(lists:sort(GroupNames))}
+    end.
+
+delete_group_member(DirData, GroupName, UserName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    Group = #httpd_group{name={GroupName, Addr, Port, Dir}, userlist=UserName},
+    case mnesia:transaction(fun() -> mnesia:delete_object(Group) end) of
+	{aborted,Reason} ->
+	    {error,Reason};
+	_ ->
+	    true
+    end.
+
+%% THIS IS WRONG (?) !
+%% Should first match out all httpd_group records for this group and then
+%% do mnesia:delete on those. Or ?
+
+delete_group(DirData, GroupName) ->
+    {Addr, Port, Dir} = lookup_common(DirData),
+    case mnesia:transaction(fun() ->
+				    mnesia:delete({httpd_group, 
+						   {GroupName,Addr,Port,Dir}})
+			    end) of
+	{aborted,Reason} ->
+	    {error,Reason};
+	_ ->
+	    true
+    end.
+
+%% Utility functions.
+
+lookup_common(DirData) ->
+    Dir = httpd_util:key1search(DirData, path),
+    Port = httpd_util:key1search(DirData, port),
+    Addr = httpd_util:key1search(DirData, bind_address),
+    {Addr, Port, Dir}.
+
+
+
+
+
+
+



Mime
View raw message