diff options
Diffstat (limited to 'lib/inets/src/http_server/mod_auth.erl')
-rw-r--r-- | lib/inets/src/http_server/mod_auth.erl | 496 |
1 files changed, 237 insertions, 259 deletions
diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl index eeacd451f0..1f4470622d 100644 --- a/lib/inets/src/http_server/mod_auth.erl +++ b/lib/inets/src/http_server/mod_auth.erl @@ -43,7 +43,10 @@ -define(NOPASSWORD,"NoPassword"). -%% do +%%==================================================================== +%% Internal application API +%%==================================================================== + do(Info) -> case proplists:get_value(status,Info#mod.data) of %% A status code has been generated! @@ -59,7 +62,6 @@ do(Info) -> %% 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 @@ -103,241 +105,6 @@ do(Info) -> 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 = proplists:get_value(require_user, DirectoryData), - ValidGroups = proplists:get_value(require_group, DirectoryData), - %% Any user or group restrictions? - case ValidGroups of - undefined when ValidUsers =:= undefined -> - authorized; - _ -> - case proplists:get_value("authorization", ParsedHeader) of - undefined -> - authorization_required(DirectoryData); - %% Check credentials! - "Basic" ++ EncodedString = Credentials -> - case (catch base64:decode_to_string(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 proplists:get_value(auth_name, DirectoryData) 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; - _Other -> - {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 proplists:get_value(auth_type, DirData, 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 inets_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 = proplists:get_value(allow_from, DirectoryData, 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 inets_regexp:match(RemoteAddr, HostRegExp) of - {match,_,_} -> - true; - nomatch -> - validate_addr(RemoteAddr,Rest) - end. - -%% deny - -deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) -> - Hosts = proplists:get_value(deny_from, DirectoryData, 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> @@ -380,7 +147,6 @@ load("AuthGroupFile " ++ AuthGroupFile0, {ok,[{directory, {Directory, [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]}; -%AuthAccessPassword load("AuthAccessPassword " ++ AuthAccessPassword0, [{directory, {Directory, DirData}}|Rest]) -> AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0), @@ -451,24 +217,6 @@ load("AuthMnesiaDB " ++ AuthMnesiaDB, " is an invalid AuthMnesiaDB")} end. -directory_config_check(Directory, DirData) -> - case proplists:get_value(auth_type, DirData) of - plain -> - check_filename_present(Directory,auth_user_file,DirData), - check_filename_present(Directory,auth_group_file,DirData); - _ -> - ok - end. -check_filename_present(Dir,AuthFile,DirData) -> - case proplists:get_value(AuthFile,DirData) of - Name when is_list(Name) -> - ok; - _ -> - throw({missing_auth_file, AuthFile, {directory, {Dir, DirData}}}) - end. - -%% store - store({directory, {Directory, DirData}}, ConfigList) when is_list(Directory) andalso is_list(DirData) -> try directory_config_check(Directory, DirData) of @@ -493,7 +241,7 @@ remove(ConfigDB) -> Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE), mod_auth_server:stop(Addr, Port, Profile), ok. -%% -------------------------------------------------------------------- + add_user(UserName, Opt) -> case get_options(Opt, mandatory) of {Addr, Port, Dir, AuthPwd}-> @@ -530,7 +278,6 @@ get_user(UserName, Port, Dir) -> get_user(UserName, Addr, Port, Dir) -> mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD). - add_group_member(GroupName, UserName, Opt)-> case get_options(Opt, mandatory) of {Addr, Port, Dir, AuthPwd}-> @@ -561,6 +308,7 @@ delete_group_member(GroupName, UserName, Port, Dir) -> delete_group_member(GroupName, UserName, Addr, Port, Dir) -> mod_auth_server:delete_group_member(Addr, Port, Dir, GroupName, UserName, ?NOPASSWORD). + list_users(Opt) -> case get_options(Opt, mandatory) of {Addr, Port, Dir, AuthPwd} -> @@ -586,7 +334,7 @@ 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(GroupName, Opt) -> case get_options(Opt, mandatory) of {Addr, Port, Dir, AuthPwd} -> @@ -642,6 +390,236 @@ update_password(_Addr, _Port, _Dir, _Old, _New, _New1) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- + +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(Info, Directory, DirectoryData) -> + ParsedHeader = Info#mod.parsed_header, + ValidUsers = proplists:get_value(require_user, DirectoryData), + ValidGroups = proplists:get_value(require_group, DirectoryData), + %% Any user or group restrictions? + case ValidGroups of + undefined when ValidUsers =:= undefined -> + authorized; + _ -> + case proplists:get_value("authorization", ParsedHeader) of + undefined -> + authorization_required(DirectoryData); + %% Check credentials! + "Basic" ++ EncodedString = Credentials -> + case (catch base64:decode_to_string(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 proplists:get_value(auth_name, DirectoryData) 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; + _Other -> + {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 proplists:get_value(auth_type, DirData, plain) of + plain -> mod_auth_plain; + mnesia -> mod_auth_mnesia; + dets -> mod_auth_dets + end. + +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 inets_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. + +allow({_,RemoteAddr}, _SocketType, _Socket, DirectoryData) -> + Hosts = proplists:get_value(allow_from, DirectoryData, 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 inets_regexp:match(RemoteAddr, HostRegExp) of + {match,_,_} -> + true; + nomatch -> + validate_addr(RemoteAddr,Rest) + end. + +deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) -> + Hosts = proplists:get_value(deny_from, DirectoryData, none), + case validate_addr(RemoteAddr,Hosts) of + true -> + {denied, ?NICE("Connection from your host is not allowed")}; + false -> + not_denied + end. + + +directory_config_check(Directory, DirData) -> + case proplists:get_value(auth_type, DirData) of + plain -> + check_filename_present(Directory,auth_user_file,DirData), + check_filename_present(Directory,auth_group_file,DirData); + _ -> + ok + end. +check_filename_present(Dir,AuthFile,DirData) -> + case proplists:get_value(AuthFile,DirData) of + Name when is_list(Name) -> + ok; + _ -> + throw({missing_auth_file, AuthFile, {directory, {Dir, DirData}}}) + end. + store_directory(Directory0, DirData0, ConfigList) -> Port = proplists:get_value(port, ConfigList), DirData = case proplists:get_value(bind_address, ConfigList) of |