Allow specifying tag for listener for api_permission purposes

This commit will allow adding tag to http listeners:

listener:
  - port: 4000
  - module: ejabberd_http
  - tag: "magic_listener"

that later can be used to have special api_permission just for it:

api_permissions:
  "magic_access":
    from:
      - tag: "magic_listener"
    who: all
    what: "*"

3 files changed, 22 insertions, 14 deletions

diff --git a/src/ejabberd_access_permissions.erl b/src/ejabberd_access_permissions.erl
index 4d673e75..368f0752 100644
--- a/src/ejabberd_access_permissions.erl
+++ b/src/ejabberd_access_permissions.erl
@@ -130,11 +130,12 @@ init([]) ->
 handle_call({can_access, Cmd, CallerInfo}, _From, State) ->
     CallerModule = maps:get(caller_module, CallerInfo, none),
     Host = maps:get(caller_host, CallerInfo, global),
+    Tag = maps:get(tag, CallerInfo, none),
     {State2, Defs0} = get_definitions(State),
     Defs = maps:get(extra_permissions, CallerInfo, []) ++ Defs0,
     Res = lists:foldl(
 	fun({Name, _} = Def, none) ->
-	    case matches_definition(Def, Cmd, CallerModule, Host, CallerInfo) of
+	    case matches_definition(Def, Cmd, CallerModule, Tag, Host, CallerInfo) of
 		true ->
 		    ?DEBUG("Command '~p' execution allowed by rule '~s' (CallerInfo=~p)", [Cmd, Name, CallerInfo]),
 		    allow;
@@ -261,10 +262,10 @@ get_definitions(#state{definitions = none, fragments_generators = Gens} = State)
 	    end,
     {State#state{definitions = NDefs}, NDefs}.
 
-matches_definition({_Name, {From, Who, What}}, Cmd, Module, Host, CallerInfo) ->
+matches_definition({_Name, {From, Who, What}}, Cmd, Module, Tag, Host, CallerInfo) ->
     case What == all orelse lists:member(Cmd, What) of
 	true ->
-	    case From == [] orelse lists:member(Module, From) of
+	    case From == [] orelse lists:member(Module, From) orelse lists:member({tag, Tag}, From) of
 		true ->
 		    Scope = maps:get(oauth_scope, CallerInfo, none),
 		    lists:any(
@@ -347,13 +348,15 @@ parse_api_permission(Name, Args0) ->
 parse_from(_Name, Module) when is_atom(Module) ->
     [Module];
 parse_from(Name, Modules) when is_list(Modules) ->
-    lists:foreach(fun(Module) when is_atom(Module) ->
-	ok;
-		     (Val) ->
-			 report_error(<<"Invalid value '~p' used inside 'from' section for api_permission '~s'">>,
-				      [Val, Name])
-		  end, Modules),
-    Modules;
+    lists:map(
+	fun(Module) when is_atom(Module) ->
+	    Module;
+	   ([{tag, Tag}]) when is_binary(Tag) ->
+	       {tag, Tag};
+	   (Val) ->
+	       report_error(<<"Invalid value '~p' used inside 'from' section for api_permission '~s'">>,
+			    [Val, Name])
+	end, Modules);
 parse_from(Name, Val) ->
     report_error(<<"Invalid value '~p' used inside 'from' section for api_permission '~s'">>,
 		 [Val, Name]).
diff --git a/src/ejabberd_http.erl b/src/ejabberd_http.erl
index f2928a02..b3222fb1 100644
--- a/src/ejabberd_http.erl
+++ b/src/ejabberd_http.erl
@@ -992,6 +992,8 @@ listen_opt_type(http_bind) ->
     fun(B) when is_boolean(B) -> B end;
 listen_opt_type(xmlrpc) ->
     fun(B) when is_boolean(B) -> B end;
+listen_opt_type(tag) ->
+    fun(B) when is_binary(B) -> B end;
 listen_opt_type(request_handlers) ->
     fun(Hs) ->
 	    Hs1 = lists:map(fun
@@ -1026,5 +1028,6 @@ listen_options() ->
      {http_bind, false},
      {xmlrpc, false},
      {request_handlers, []},
+     {tag, <<>>},
      {default_host, undefined},
      {custom_headers, []}].
diff --git a/src/mod_http_api.erl b/src/mod_http_api.erl
index 0d1d7c66..d31ca0f1 100644
--- a/src/mod_http_api.erl
+++ b/src/mod_http_api.erl
@@ -137,7 +137,7 @@ depends(_Host, _Opts) ->
 %% basic auth
 %% ----------
 
-extract_auth(#request{auth = HTTPAuth, ip = {IP, _}}) ->
+extract_auth(#request{auth = HTTPAuth, ip = {IP, _}, opts = Opts}) ->
     Info = case HTTPAuth of
             {SJID, Pass} ->
                 try jid:decode(SJID) of
@@ -163,13 +163,15 @@ extract_auth(#request{auth = HTTPAuth, ip = {IP, _}}) ->
         end,
     case Info of
 	Map when is_map(Map) ->
-	    Map#{caller_module => ?MODULE, ip => IP};
+	    Tag = proplists:get_value(tag, Opts, <<>>),
+	    Map#{caller_module => ?MODULE, ip => IP, tag => Tag};
 	_ ->
 	    ?DEBUG("Invalid auth data: ~p", [Info]),
 	    Info
     end;
-extract_auth(#request{ip = IP}) ->
-    #{ip => IP, caller_module => ?MODULE}.
+extract_auth(#request{ip = IP, opts = Opts}) ->
+    Tag = proplists:get_value(tag, Opts, <<>>),
+    #{ip => IP, caller_module => ?MODULE, tag => Tag}.
 
 %% ------------------
 %% command processing