mod_adhoc_api: New module to execute API Commands using Ad-Hoc Commands

ejabberd.yml.example

@@ -118,7 +118,12 @@ api_permissions:
     from: ejabberd_web_admin
     who: admin
     what: "*"
-  "admin access":
+  "adhoc commands":
+    from: mod_adhoc_api
+    who: admin
+    what: "*"
+  "http access":
+    from: mod_http_api
     who:
       access:
         allow:
@@ -159,6 +164,7 @@ shaper_rules:
 
 modules:
   mod_adhoc: {}
+  mod_adhoc_api: {}
   mod_admin_extra: {}
   mod_announce:
     access: announce

src/ejabberd_access_permissions.erl

@@ -344,10 +344,20 @@ validator(from) ->
     fun(L) when is_list(L) ->
 	    lists:map(
 	      fun({K, V}) -> {(econf:enum([tag]))(K), (econf:binary())(V)};
-		 (A) -> (econf:enum([ejabberd_xmlrpc, mod_cron, mod_http_api, ejabberd_ctl, ejabberd_web_admin]))(A)
+		 (A) -> (econf:enum([ejabberd_ctl,
+                                     ejabberd_web_admin,
+                                     ejabberd_xmlrpc,
+                                     mod_adhoc_api,
+                                     mod_cron,
+                                     mod_http_api]))(A)
 	      end, lists:flatten(L));
        (A) ->
-	    [(econf:enum([ejabberd_xmlrpc, mod_cron, mod_http_api, ejabberd_ctl, ejabberd_web_admin]))(A)]
+	    [(econf:enum([ejabberd_ctl,
+                          ejabberd_web_admin,
+                          ejabberd_xmlrpc,
+                          mod_adhoc_api,
+                          mod_cron,
+                          mod_http_api]))(A)]
     end;
 validator(what) ->
     econf:and_then(

src/ejabberd_commands.erl

@@ -33,6 +33,7 @@
 -export([start_link/0,
 	 list_commands/0,
 	 list_commands/1,
+	 list_commands/2,
 	 get_command_format/1,
 	 get_command_format/2,
 	 get_command_format/3,
@@ -217,6 +218,16 @@ list_commands(Version) ->
                                               desc = Desc} <- Commands,
                            not lists:member(internal, Tags)].
 
+-spec list_commands(integer(), map()) -> [{atom(), [aterm()], string()}].
+
+list_commands(Version, CallerInfo) ->
+    lists:filter(
+      fun({Name, _Args, _Desc}) ->
+        allow == ejabberd_access_permissions:can_access(Name, CallerInfo)
+      end,
+      list_commands(Version)
+    ).
+
 -spec get_command_format(atom()) -> {[aterm()], [{atom(),atom()}], rterm()}.
 
 get_command_format(Name) ->

src/mod_adhoc_api.erl

@@ -0,0 +1,729 @@
+%%%----------------------------------------------------------------------
+%%% File    : mod_adhoc_api.erl
+%%% Author  : Badlop <badlop@process-one.net>
+%%% Purpose : Frontend for ejabberd API Commands via XEP-0050 Ad-Hoc Commands
+%%% Created : 21 Feb 2025 by Badlop <badlop@process-one.net>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2025   ProcessOne
+%%%
+%%% This program is free software; you can redistribute it and/or
+%%% modify it under the terms of the GNU General Public License as
+%%% published by the Free Software Foundation; either version 2 of the
+%%% License, or (at your option) any later version.
+%%%
+%%% This program is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+%%% General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License along
+%%% with this program; if not, write to the Free Software Foundation, Inc.,
+%%% 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+%%%
+%%%----------------------------------------------------------------------
+
+%%%% definitions
+%% @format-begin
+
+-module(mod_adhoc_api).
+
+-behaviour(gen_mod).
+
+-author('badlop@process-one.net').
+
+%% gen_mod callbacks
+-export([start/2, stop/1, reload/3, mod_opt_type/1, mod_options/1, depends/2, mod_doc/0]).
+%% hooks
+-export([adhoc_local_commands/4, adhoc_local_items/4, disco_local_features/5,
+         disco_local_identity/5, disco_local_items/5]).
+
+-include("ejabberd_commands.hrl").
+-include("ejabberd_sm.hrl").
+-include("logger.hrl").
+-include("translate.hrl").
+
+-include_lib("stdlib/include/ms_transform.hrl").
+-include_lib("xmpp/include/xmpp.hrl").
+
+-define(DEFAULT_API_VERSION, 1000000).
+
+%%%==================================
+%%%% gen_mod
+
+start(_Host, _Opts) ->
+    {ok,
+     [{hook, adhoc_local_commands, adhoc_local_commands, 40},
+      {hook, adhoc_local_items, adhoc_local_items, 40},
+      {hook, disco_local_features, disco_local_features, 40},
+      {hook, disco_local_identity, disco_local_identity, 40},
+      {hook, disco_local_items, disco_local_items, 40}]}.
+
+stop(_Host) ->
+    ok.
+
+reload(_Host, _NewOpts, _OldOpts) ->
+    ok.
+
+mod_opt_type(default_version) ->
+    econf:either(
+        econf:int(0, 3),
+        econf:and_then(
+            econf:binary(),
+            fun(Binary) ->
+               case binary_to_list(Binary) of
+                   F when F >= "24.06" ->
+                       2;
+                   F when (F > "23.10") and (F < "24.06") ->
+                       1;
+                   F when F =< "23.10" ->
+                       0
+               end
+            end)).
+
+-spec mod_options(binary()) -> [{default_version, integer()}].
+mod_options(_) ->
+    [{default_version, ?DEFAULT_API_VERSION}].
+
+depends(_Host, _Opts) ->
+    [{mod_adhoc, hard}, {mod_last, soft}].
+
+mod_doc() ->
+    #{desc =>
+          ?T("Execute https://docs.ejabberd.im/developer/ejabberd-api/[API Commands] "
+             "in a XMPP client using "
+             "https://xmpp.org/extensions/xep-0050.html[XEP-0050: Ad-Hoc Commands]. "
+             "This module requires _`mod_adhoc`_ (to execute the commands), "
+             "and recommends _`mod_disco`_ (to discover the commands)."),
+      note => "added in 25.xx",
+      opts =>
+          [{default_version,
+            #{value => "integer() | string()",
+              desc =>
+                  ?T("What API version to use. "
+                     "If setting an ejabberd version, it will use the latest API "
+                     "version that was available in that ejabberd version. "
+                     "For example, setting '\"24.06\"' in this option implies '2'. "
+                     "The default value is the latest version.")}}],
+      example =>
+          ["acl:",
+           "  admin:",
+           "    user: jan@localhost",
+           "",
+           "api_permissions:",
+           "  \"adhoc commands\":",
+           "    from: mod_adhoc_api",
+           "    who: admin",
+           "    what:",
+           "      - \"[tag:roster]\"",
+           "      - \"[tag:session]\"",
+           "      - stats",
+           "      - status",
+           "",
+           "modules:",
+           "  mod_adhoc_api:",
+           "    default_version: 2"]}.
+
+%%%==================================
+%%%% Ad-Hoc Commands (copied from mod_configure)
+
+-define(INFO_IDENTITY(Category, Type, Name, Lang),
+        [#identity{category = Category,
+                   type = Type,
+                   name = tr(Lang, Name)}]).
+-define(INFO_COMMAND(Name, Lang),
+        ?INFO_IDENTITY(<<"automation">>, <<"command-node">>, Name, Lang)).
+-define(NODE(Name, Node),
+        #disco_item{jid = jid:make(Server),
+                    node = Node,
+                    name = tr(Lang, Name)}).
+
+-spec tokenize(binary()) -> [binary()].
+tokenize(Node) ->
+    str:tokens(Node, <<"/#">>).
+
+-spec tr(binary(), binary()) -> binary().
+tr(Lang, Text) ->
+    translate:translate(Lang, Text).
+
+%%%==================================
+%%%% - disco identity
+
+-spec disco_local_identity([identity()], jid(), jid(), binary(), binary()) ->
+                              [identity()].
+disco_local_identity(Acc, _From, #jid{lserver = LServer} = _To, Node, Lang) ->
+    case tokenize(Node) of
+        [<<"api-commands">>] ->
+            ?INFO_COMMAND(?T("API Commands"), Lang);
+        [<<"api-commands">>, CommandName] ->
+            ?INFO_COMMAND(get_api_command_desc(CommandName, LServer), Lang);
+        _ ->
+            Acc
+    end.
+
+get_api_command_desc(NameAtom, Host) ->
+    iolist_to_binary((get_api_command(NameAtom, Host))#ejabberd_commands.desc).
+
+%%%==================================
+%%%% - disco features
+
+-spec disco_local_features(mod_disco:features_acc(), jid(), jid(), binary(), binary()) ->
+                              mod_disco:features_acc().
+disco_local_features(Acc, _From, #jid{lserver = LServer} = _To, Node, _Lang) ->
+    case gen_mod:is_loaded(LServer, mod_adhoc) of
+        false ->
+            Acc;
+        _ ->
+            case tokenize(Node) of
+                [<<"api-commands">>] ->
+                    {result, []};
+                [<<"api-commands">>, _] ->
+                    {result, [?NS_COMMANDS]};
+                _ ->
+                    Acc
+            end
+    end.
+
+%%%==================================
+%%%% - adhoc items
+
+-spec adhoc_local_items(mod_disco:items_acc(), jid(), jid(), binary()) ->
+                           mod_disco:items_acc().
+adhoc_local_items(Acc, From, #jid{lserver = LServer, server = Server} = To, Lang) ->
+    Items =
+        case Acc of
+            {result, Its} ->
+                Its;
+            empty ->
+                []
+        end,
+    Nodes = recursively_get_local_items(From, global, LServer, <<"">>, Server, Lang),
+    Nodes1 =
+        lists:filter(fun(#disco_item{node = Nd}) ->
+                        F = disco_local_features(empty, From, To, Nd, Lang),
+                        case F of
+                            {result, [?NS_COMMANDS]} ->
+                                true;
+                            _ ->
+                                false
+                        end
+                     end,
+                     Nodes),
+    {result, Items ++ Nodes1}.
+
+-spec recursively_get_local_items(jid(),
+                                  global | vhost,
+                                  binary(),
+                                  binary(),
+                                  binary(),
+                                  binary()) ->
+                                     [disco_item()].
+recursively_get_local_items(From, PermLev, LServer, Node, Server, Lang) ->
+    Items =
+        case get_local_items2(From, {PermLev, LServer}, tokenize(Node), Server, Lang) of
+            {result, Res} ->
+                Res;
+            {error, _Error} ->
+                []
+        end,
+    lists:flatten(
+        lists:map(fun(#disco_item{jid = #jid{server = S}, node = Nd} = Item) ->
+                     if (S /= Server) or (Nd == <<"">>) ->
+                            [];
+                        true ->
+                            [Item,
+                             recursively_get_local_items(From, PermLev, LServer, Nd, Server, Lang)]
+                     end
+                  end,
+                  Items)).
+
+%%%==================================
+%%%% - disco items
+
+-spec disco_local_items(mod_disco:items_acc(), jid(), jid(), binary(), binary()) ->
+                           mod_disco:items_acc().
+disco_local_items(Acc, From, #jid{lserver = LServer} = To, Node, Lang) ->
+    case gen_mod:is_loaded(LServer, mod_adhoc) of
+        false ->
+            Acc;
+        _ ->
+            Items =
+                case Acc of
+                    {result, Its} ->
+                        Its;
+                    empty ->
+                        [];
+                    Other ->
+                        Other
+                end,
+            case tokenize(Node) of
+                LNode when (LNode == [<<"api-commands">>]) or (LNode == []) ->
+                    case get_local_items2(From, {global, LServer}, LNode, jid:encode(To), Lang) of
+                        {result, Res} ->
+                            {result, Res};
+                        {error, Error} ->
+                            {error, Error}
+                    end;
+                _ ->
+                    {result, Items}
+            end
+    end.
+
+%%%==================================
+%%%% - get_local_items2
+
+-spec get_local_items2(jid(),
+                       {global | vhost, binary()},
+                       [binary()],
+                       binary(),
+                       binary()) ->
+                          {result, [disco_item()]} | {error, stanza_error()}.
+get_local_items2(_From, _Host, [], Server, Lang) ->
+    {result, [?NODE(?T("API Commands"), <<"api-commands">>)]};
+get_local_items2(From, {_, Host}, [<<"api-commands">>], _Server, Lang) ->
+    {result, get_api_commands(From, Host, Lang)};
+get_local_items2(_From, {_, _Host}, [<<"api-commands">>, _], _Server, _Lang) ->
+    {result, []};
+get_local_items2(_From, _Host, _, _Server, _Lang) ->
+    {error, xmpp:err_item_not_found()}.
+
+-spec get_api_commands(jid(), binary(), binary()) -> [disco_item()].
+get_api_commands(From, Server, Lang) ->
+    ApiVersion = mod_adhoc_api_opt:default_version(Server),
+    lists:map(fun({Name, _Args, _Desc}) ->
+                 NameBin = list_to_binary(atom_to_list(Name)),
+                 ?NODE(NameBin, <<"api-commands/", NameBin/binary>>)
+              end,
+              ejabberd_commands:list_commands(ApiVersion, get_caller_info(From))).
+
+%%%==================================
+%%%% - adhoc commands
+
+-define(COMMANDS_RESULT(LServerOrGlobal, From, To, Request, Lang),
+        adhoc_local_commands(From, To, Request)).
+
+-spec adhoc_local_commands(adhoc_command(), jid(), jid(), adhoc_command()) ->
+                              adhoc_command() | {error, stanza_error()}.
+adhoc_local_commands(Acc, From, To, #adhoc_command{node = Node} = Request) ->
+    case tokenize(Node) of
+        [<<"api-commands">>, _CommandName] ->
+            ?COMMANDS_RESULT(LServer, From, To, Request, Lang);
+        _ ->
+            Acc
+    end.
+
+-spec adhoc_local_commands(jid(), jid(), adhoc_command()) ->
+                              adhoc_command() | {error, stanza_error()}.
+adhoc_local_commands(From,
+                     #jid{lserver = LServer} = _To,
+                     #adhoc_command{lang = Lang,
+                                    node = Node,
+                                    sid = SessionID,
+                                    action = Action,
+                                    xdata = XData} =
+                         Request) ->
+    LNode = tokenize(Node),
+    ActionIsExecute = Action == execute orelse Action == complete,
+    if Action == cancel ->
+           #adhoc_command{status = canceled,
+                          lang = Lang,
+                          node = Node,
+                          sid = SessionID};
+       XData == undefined, ActionIsExecute ->
+           case get_form(LServer, LNode, Lang) of
+               {result, Form} ->
+                   xmpp_util:make_adhoc_response(Request,
+                                                 #adhoc_command{status = executing, xdata = Form});
+               {error, Error} ->
+                   {error, Error}
+           end;
+       XData /= undefined, ActionIsExecute ->
+           case set_form(From, LServer, LNode, Lang, XData) of
+               {result, Res} ->
+                   xmpp_util:make_adhoc_response(Request,
+                                                 #adhoc_command{xdata = Res, status = completed});
+               %%{'EXIT', _} -> {error, xmpp:err_bad_request()};
+               {error, Error} ->
+                   {error, Error}
+           end;
+       true ->
+           {error, xmpp:err_bad_request(?T("Unexpected action"), Lang)}
+    end.
+
+-spec get_form(binary(), [binary()], binary()) ->
+                  {result, xdata()} | {error, stanza_error()}.
+get_form(Host, [<<"api-commands">>, CommandName], Lang) ->
+    get_form_api_command(CommandName, Host, Lang);
+get_form(_Host, _, _Lang) ->
+    {error, xmpp:err_service_unavailable()}.
+
+-spec set_form(jid(), binary(), [binary()], binary(), xdata()) ->
+                  {result, xdata() | undefined} | {error, stanza_error()}.
+set_form(From, Host, [<<"api-commands">>, Command], Lang, XData) ->
+    set_form_api_command(From, Host, Command, XData, Lang);
+set_form(_From, _Host, _, _Lang, _XData) ->
+    {error, xmpp:err_service_unavailable()}.
+
+%%%==================================
+%%%% API Commands
+
+get_api_command(Name, Host) when is_binary(Name) ->
+    get_api_command(binary_to_existing_atom(Name, latin1), Host);
+get_api_command(Name, Host) when is_atom(Name) ->
+    ApiVersion = mod_adhoc_api_opt:default_version(Host),
+    ejabberd_commands:get_command_definition(Name, ApiVersion).
+
+get_caller_info(#jid{user = User, server = Server} = From) ->
+    #{tag => <<>>,
+      usr => {User, Server, <<"">>},
+      caller_server => Server,
+      ip => get_ip_address(From),
+      caller_module => ?MODULE}.
+
+get_ip_address(#jid{user = User,
+                    server = Server,
+                    resource = Resource}) ->
+    case ejabberd_sm:get_user_ip(User, Server, Resource) of
+        {IP, _Port} when is_tuple(IP) ->
+            IP;
+        _ ->
+            error_ip_address
+    end.
+
+%%%==================================
+%%%% - get form
+
+get_form_api_command(NameBin, Host, _Lang) ->
+    Def = get_api_command(NameBin, Host),
+    Title = list_to_binary(atom_to_list(Def#ejabberd_commands.name)),
+    Instructions = get_instructions(Def),
+    FieldsArgs =
+        build_fields(Def#ejabberd_commands.args,
+                     Def#ejabberd_commands.args_desc,
+                     Def#ejabberd_commands.args_example,
+                     Def#ejabberd_commands.policy,
+                     get_replacements(Host),
+                     true),
+    FieldsArgsWithHeads =
+        case FieldsArgs of
+            [] ->
+                [];
+            _ ->
+                [#xdata_field{type = fixed, label = ?T("Arguments")} | FieldsArgs]
+        end,
+    NodeFields = build_node_fields(),
+    {result,
+     #xdata{title = Title,
+            type = form,
+            instructions = Instructions,
+            fields = FieldsArgsWithHeads ++ NodeFields}}.
+
+get_replacements(Host) ->
+    [{user, <<"">>},
+     {localuser, <<"">>},
+     {host, Host},
+     {localhost, Host},
+     {password, <<"">>},
+     {newpass, <<"">>},
+     {service, mod_muc_admin:find_hosts(Host)}].
+
+build_node_fields() ->
+    build_node_fields([node() | nodes()]).
+
+build_node_fields([_ThisNode]) ->
+    [];
+build_node_fields(AtomNodes) ->
+    [ThisNode | _] = Nodes = [atom_to_binary(Atom, latin1) || Atom <- AtomNodes],
+    Options = [#xdata_option{label = N, value = N} || N <- Nodes],
+    [#xdata_field{type = fixed, label = ?T("Clustering")},
+     #xdata_field{type = 'list-single',
+                  label = <<"ejabberd node">>,
+                  var = <<"mod_adhoc_api_target_node">>,
+                  values = [ThisNode],
+                  options = Options}].
+
+%%%==================================
+%%%% - set form
+
+set_form_api_command(From, Host, CommandNameBin, XData, _Lang) ->
+    %% Description
+    Def = get_api_command(CommandNameBin, Host),
+    Title = list_to_binary(atom_to_list(Def#ejabberd_commands.name)),
+    Instructions = get_instructions(Def),
+
+    %% Arguments
+    FieldsArgs1 = [Field || Field <- XData#xdata.fields, Field#xdata_field.type /= fixed],
+
+    {Node, FieldsArgs} =
+        case lists:keytake(<<"mod_adhoc_api_target_node">>, #xdata_field.var, FieldsArgs1) of
+            {value, #xdata_field{values = [TargetNode]}, FAs} ->
+                {binary_to_existing_atom(TargetNode, latin1), FAs};
+            false ->
+                {node(), FieldsArgs1}
+        end,
+
+    FieldsArgsWithHeads =
+        case FieldsArgs of
+            [] ->
+                [];
+            _ ->
+                [#xdata_field{type = fixed, label = ?T("Arguments")} | FieldsArgs]
+        end,
+
+    %% Execute
+    Arguments = api_extract_fields(FieldsArgs, Def#ejabberd_commands.args),
+    ApiVersion = mod_adhoc_api_opt:default_version(Host),
+    CallResult =
+        ejabberd_cluster:call(Node,
+                              mod_http_api,
+                              handle,
+                              [binary_to_existing_atom(CommandNameBin, latin1),
+                               get_caller_info(From),
+                               Arguments,
+                               ApiVersion]),
+
+    %% Command result
+    FieldsResult2 =
+        case CallResult of
+            {200, RR} ->
+                build_fields([Def#ejabberd_commands.result],
+                             [Def#ejabberd_commands.result_desc],
+                             [RR],
+                             restricted,
+                             [{host, Host}],
+                             false);
+            {Code, _ApiErrorCode, MessageBin} ->
+                [#xdata_field{type = 'text-single',
+                              label = <<"Error ", (integer_to_binary(Code))/binary>>,
+                              values = encode(MessageBin, irrelevat_type),
+                              var = <<"error">>}];
+            {Code, MessageBin} ->
+                [#xdata_field{type = 'text-single',
+                              label = <<"Error ", (integer_to_binary(Code))/binary>>,
+                              values = encode(MessageBin, irrelevat_type),
+                              var = <<"error">>}]
+        end,
+    FieldsResultWithHeads =
+        [#xdata_field{type = fixed, label = ?T("")},
+         #xdata_field{type = fixed, label = ?T("Result")}
+         | FieldsResult2],
+
+    %% Result stanza
+    {result,
+     #xdata{title = Title,
+            type = result,
+            instructions = Instructions,
+            fields = FieldsArgsWithHeads ++ FieldsResultWithHeads}}.
+
+api_extract_fields(Fields, ArgsDef) ->
+    lists:map(fun(#xdata_field{values = Values, var = ANameBin}) ->
+                 ArgDef = proplists:get_value(binary_to_existing_atom(ANameBin, latin1), ArgsDef),
+                 V = case {Values, ArgDef} of
+                         {Values, {list, {_ElementName, {tuple, ElementsDef}}}} ->
+                             [parse_tuple(ElementsDef, Value) || Value <- Values];
+                         {[Value], {tuple, ElementsDef}} ->
+                             parse_tuple(ElementsDef, Value);
+                         {[Value], _} ->
+                             Value;
+                         _ ->
+                             Values
+                     end,
+                 {ANameBin, V}
+              end,
+              Fields).
+
+parse_tuple(ElementsDef, Value) ->
+    Values = str:tokens(Value, <<":">>),
+    List1 =
+        [{atom_to_binary(Name, latin1), Val}
+         || {{Name, _Type}, Val} <- lists:zip(ElementsDef, Values)],
+    maps:from_list(List1).
+
+%%%==================================
+%%%% - get instructions
+
+get_instructions(Def) ->
+    Note2 =
+        case Def#ejabberd_commands.note of
+            [] ->
+                [];
+            Note ->
+                N = iolist_to_binary(Note),
+                [<<"Note: ", N/binary>>]
+        end,
+    Tags2 =
+        case Def#ejabberd_commands.tags of
+            [] ->
+                [];
+            Tags ->
+                T = str:join([atom_to_binary(Tag, latin1) || Tag <- Tags], <<", ">>),
+                [<<"Tags: ", T/binary>>]
+        end,
+    Module2 =
+        case Def#ejabberd_commands.definer of
+            unknown ->
+                [];
+            DefinerAtom ->
+                D = atom_to_binary(DefinerAtom, latin1),
+                [<<"Module: ", D/binary>>]
+        end,
+    Version2 =
+        case Def#ejabberd_commands.version of
+            0 ->
+                [];
+            Version ->
+                V = integer_to_binary(Version),
+                [<<"API version: ", V/binary>>]
+        end,
+    get_instructions2([Def#ejabberd_commands.desc, Def#ejabberd_commands.longdesc]
+                      ++ Note2
+                      ++ Tags2
+                      ++ Module2
+                      ++ Version2).
+
+get_instructions2(ListStrings) ->
+    [re:replace(String, "[\t]*[  ]+", " ", [{return, binary}, global])
+     || String <- ListStrings, String /= ""].
+
+%%%==================================
+%%%% - build fields
+
+build_fields(NameTypes, none, Examples, Policy, Replacements, Required) ->
+    build_fields(NameTypes, [], Examples, Policy, Replacements, Required);
+build_fields(NameTypes, Descs, none, Policy, Replacements, Required) ->
+    build_fields(NameTypes, Descs, [], Policy, Replacements, Required);
+build_fields(NameTypes, [none], Examples, Policy, Replacements, Required) ->
+    build_fields(NameTypes, [], Examples, Policy, Replacements, Required);
+build_fields(NameTypes, Descs, [none], Policy, Replacements, Required) ->
+    build_fields(NameTypes, Descs, [], Policy, Replacements, Required);
+build_fields(NameTypes, Descs, Examples, Policy, Replacements, Required) ->
+    {NameTypes2, Descs2, Examples2} =
+        case Policy of
+            user ->
+                {[{user, binary}, {host, binary} | NameTypes],
+                 ["Username", "Server host" | Descs],
+                 ["tom", "example.com" | Examples]};
+            _ ->
+                {NameTypes, Descs, Examples}
+        end,
+    build_fields2(NameTypes2, Descs2, Examples2, Replacements, Required).
+
+build_fields2([{_ArgName, {list, _ArgNameType}}] = NameTypes,
+              Descs,
+              Examples,
+              _Replacements,
+              Required) ->
+    Args = lists_zip3_pad(NameTypes, Descs, Examples),
+    lists:map(fun({{AName, AType}, ADesc, AExample}) ->
+                 ANameBin = list_to_binary(atom_to_list(AName)),
+                 #xdata_field{type = 'text-multi',
+                              label = ANameBin,
+                              desc = list_to_binary(ADesc),
+                              values = encode(AExample, AType),
+                              required = Required,
+                              var = ANameBin}
+              end,
+              Args);
+build_fields2(NameTypes, Descs, Examples, Replacements, Required) ->
+    Args = lists_zip3_pad(NameTypes, Descs, Examples),
+    lists:map(fun({{AName, AType}, ADesc, AExample}) ->
+                 ANameBin = list_to_binary(atom_to_list(AName)),
+                 AValue = proplists:get_value(AName, Replacements, AExample),
+                 Values = encode(AValue, AType),
+                 Type =
+                     case {AType, Values} of
+                         {{list, _}, _} ->
+                             'text-multi';
+                         {string, [_, _ | _]} ->
+                             'text-multi';
+                         _ ->
+                             'text-single'
+                     end,
+                 #xdata_field{type = Type,
+                              label = ANameBin,
+                              desc = make_desc(ADesc, AValue),
+                              values = Values,
+                              required = Required,
+                              var = ANameBin}
+              end,
+              Args).
+
+-ifdef(OTP_BELOW_26).
+
+lists_zip3_pad(As, Bs, Cs) ->
+    lists_zip3_pad(As, Bs, Cs, []).
+
+lists_zip3_pad([A | As], [B | Bs], [C | Cs], Xs) ->
+    lists_zip3_pad(As, Bs, Cs, [{A, B, C} | Xs]);
+lists_zip3_pad([A | As], [B | Bs], Nil, Xs) when (Nil == none) or (Nil == []) ->
+    lists_zip3_pad(As, Bs, [], [{A, B, ""} | Xs]);
+lists_zip3_pad([A | As], Nil, [C | Cs], Xs) when (Nil == none) or (Nil == []) ->
+    lists_zip3_pad(As, [], Cs, [{A, "", C} | Xs]);
+lists_zip3_pad([A | As], Nil, Nil, Xs) when (Nil == none) or (Nil == []) ->
+    lists_zip3_pad(As, [], [], [{A, "", ""} | Xs]);
+lists_zip3_pad([], Nil, Nil, Xs) when (Nil == none) or (Nil == []) ->
+    lists:reverse(Xs).
+
+-else.
+
+lists_zip3_pad(As, Bs, Cs) ->
+    lists:zip3(As, Bs, Cs, {pad, {error_missing_args_def, "", ""}}).
+
+-endif.
+
+make_desc(ADesc, T) when is_tuple(T) ->
+    T3 = string:join(tuple_to_list(T), " : "),
+    iolist_to_binary([ADesc, " {", T3, "}"]);
+make_desc(ADesc, M) when is_map(M) ->
+    M2 = [binary_to_list(V) || V <- maps:keys(M)],
+    M3 = string:join(M2, " : "),
+    iolist_to_binary([ADesc, " {", M3, "}"]);
+make_desc(ADesc, _M) ->
+    iolist_to_binary(ADesc).
+
+%%%==================================
+%%%% - encode
+
+encode({[T | _] = List}, Type) when is_tuple(T) ->
+    encode(List, Type);
+encode([T | _] = List, Type) when is_tuple(T) ->
+    [encode(Element, Type) || Element <- List];
+encode(T, _Type) when is_tuple(T) ->
+    T2 = [x_to_binary(E) || E <- tuple_to_list(T)],
+    T3 = str:join(T2, <<":">>),
+    [T3];
+encode(M, {tuple, Types}) when is_map(M) ->
+    M2 = [x_to_list(maps:get(atom_to_binary(Key, latin1), M))
+          || {Key, _ElementType} <- Types],
+    M3 = string:join(M2, " : "),
+    [iolist_to_binary(M3)];
+encode([S | _] = SList, _Type) when is_list(S) ->
+    [iolist_to_binary(A) || A <- SList];
+encode([B | _] = BList, _Type) when is_binary(B) ->
+    BList;
+encode(I, _Type) when is_integer(I) ->
+    [integer_to_binary(I)];
+encode([M | _] = List, {list, {_Name, TupleType}}) when is_map(M) ->
+    [encode(M1, TupleType) || M1 <- List];
+encode(S, _Type) when is_list(S) ->
+    [iolist_to_binary(S)];
+encode(B, _Type) when is_binary(B) ->
+    str:tokens(B, <<"\n">>).
+
+x_to_list(B) when is_binary(B) ->
+    binary_to_list(B);
+x_to_list(I) when is_integer(I) ->
+    integer_to_list(I);
+x_to_list(L) when is_list(L) ->
+    L.
+
+x_to_binary(B) when is_binary(B) ->
+    B;
+x_to_binary(I) when is_integer(I) ->
+    integer_to_binary(I);
+x_to_binary(L) when is_list(L) ->
+    iolist_to_binary(L).
+
+%%%==================================
+
+%%% vim: set foldmethod=marker foldmarker=%%%%,%%%=:

src/mod_adhoc_api_opt.erl

@@ -0,0 +1,13 @@
+%% Generated automatically
+%% DO NOT EDIT: run `make options` instead
+
+-module(mod_adhoc_api_opt).
+
+-export([default_version/1]).
+
+-spec default_version(gen_mod:opts() | global | binary()) -> integer().
+default_version(Opts) when is_map(Opts) ->
+    gen_mod:get_opt(default_version, Opts);
+default_version(Host) ->
+    gen_mod:get_module_opt(Host, mod_adhoc_api, default_version).
+

src/mod_http_api.erl

@@ -30,7 +30,7 @@
 -behaviour(gen_mod).
 
 -export([start/2, stop/1, reload/3, process/2, depends/2,
-         format_arg/2,
+         format_arg/2, handle/4,
 	 mod_opt_type/1, mod_options/1, mod_doc/0]).
 
 -include_lib("xmpp/include/xmpp.hrl").
@@ -353,6 +353,9 @@ format_arg(Elements,
      || Element <- Elements];
 
 %% Covered by command_test_list and command_test_list_tuple
+format_arg(Element, {list, Def})
+    when not is_list(Element) ->
+    format_arg([Element], {list, Def});
 format_arg(Elements,
 	   {list, {_ElementDefName, ElementDefFormat}})
     when is_list(Elements) ->
@@ -395,6 +398,7 @@ format_arg(Elements, {list, ElementsDef})
      || Element <- Elements];
 
 format_arg(Arg, integer) when is_integer(Arg) -> Arg;
+format_arg(Arg, integer) when is_binary(Arg) -> binary_to_integer(Arg);
 format_arg(Arg, binary) when is_list(Arg) -> process_unicode_codepoints(Arg);
 format_arg(Arg, binary) when is_binary(Arg) -> Arg;
 format_arg(Arg, string) when is_list(Arg) -> Arg;
@@ -460,6 +464,9 @@ format_result([String | _] = StringList, {Name, string}) when is_list(String) ->
 format_result(String, {Name, string}) ->
     {misc:atom_to_binary(Name), iolist_to_binary(String)};
 
+format_result(Binary, {Name, binary}) ->
+    {misc:atom_to_binary(Name), Binary};
+
 format_result(Code, {Name, rescode}) ->
     {misc:atom_to_binary(Name), Code == true orelse Code == ok};
 

test/commands_tests.erl

@@ -23,8 +23,6 @@
 
 %%%% definitions
 
-%% @format-begin
-
 -module(commands_tests).
 
 -compile(export_all).
@@ -56,10 +54,29 @@ single_cases() ->
       single_test(http_tuple),
       single_test(http_list_tuple),
       single_test(http_list_tuple_map),
+      single_test(adhoc_list_commands),
+      single_test(adhoc_apiversion),
+      single_test(adhoc_apizero),
+      single_test(adhoc_apione),
+      single_test(adhoc_integer),
+      single_test(adhoc_string),
+      single_test(adhoc_binary),
+      single_test(adhoc_tuple),
+      single_test(adhoc_list),
+      single_test(adhoc_list_tuple),
+      single_test(adhoc_atom),
+      single_test(adhoc_rescode),
+      single_test(adhoc_restuple),
+      %%single_test(adhoc_all),
       single_test(clean)]}.
 
 -endif.
 
+%% @format-begin
+
+single_test(T) ->
+    list_to_atom("commands_" ++ atom_to_list(T)).
+
 setup(_Config) ->
     M = <<"mod_example">>,
     clean(_Config),
@@ -90,6 +107,9 @@ ejabberdctl(_Config) ->
     Installed = execute(modules_installed, []),
     ?match(true, lists:keymember(mod_example, 1, Installed)).
 
+execute(Name, Args) ->
+    ejabberd_commands:execute_command2(Name, Args, #{caller_module => ejabberd_ctl}, 1000000).
+
 %%%==================================
 %%%% mod_http_api
 
@@ -165,19 +185,7 @@ http_list_tuple_map(Config) ->
                       #{<<"element1">> => <<"three">>, <<"element2">> => <<"tres">>}]),
     ?match(LTB, lists:sort(query(Config, "command_test_list_tuple", #{arg_list => LTA}))).
 
-%%%==================================
+%%% internal functions
-%%%% internal functions
-
-single_test(T) ->
-    list_to_atom("commands_" ++ atom_to_list(T)).
-
-execute(Name, Args) ->
-    ejabberd_commands:execute_command2(Name, Args, #{caller_module => ejabberd_ctl}, 1000000).
-
-page(Config, Tail) ->
-    Server = ?config(server_host, Config),
-    Port = ct:get_config(web_port, 5280),
-    "http://" ++ Server ++ ":" ++ integer_to_list(Port) ++ "/api/" ++ Tail.
 
 query(Config, Tail, Map) ->
     BodyQ = misc:json_encode(Map),
@@ -192,6 +200,248 @@ make_query(Config, Tail, BodyQ) ->
                          [{body_format, binary}]),
            Body).
 
+page(Config, Tail) ->
+    Server = ?config(server_host, Config),
+    Port = ct:get_config(web_port, 5280),
+    "http://" ++ Server ++ ":" ++ integer_to_list(Port) ++ "/api/" ++ Tail.
+
+%%%==================================
+%%%% ad-hoc
+
+%%% list commands
+
+adhoc_list_commands(Config) ->
+    {ok, Result} = get_items(Config, <<"api-commands">>),
+    {value, #disco_item{name = <<"command_test_binary">>}} =
+        lists:keysearch(<<"command_test_binary">>, #disco_item.name, Result),
+    suite:disconnect(Config).
+
+get_items(Config, Node) ->
+    case suite:send_recv(Config,
+                         #iq{type = get,
+                             to = server_jid(Config),
+                             sub_els = [#disco_items{node = Node}]})
+    of
+        #iq{type = result, sub_els = [#disco_items{node = Node, items = Items}]} ->
+            {ok, Items};
+        #iq{type = result, sub_els = []} ->
+            {empty, []};
+        #iq{type = error} = Err ->
+            xmpp:get_error(Err)
+    end.
+
+%%% apiversion
+
+adhoc_apiversion(Config) ->
+    Node = <<"api-commands/command_test_apiversion">>,
+    ArgFields = make_fields_args([]),
+    ResFields = make_fields_res([{<<"apiversion">>, <<"2">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% apizero
+
+adhoc_apizero(Config) ->
+    Node = <<"api-commands/command_test_apizero">>,
+    ArgFields = make_fields_args([]),
+    ResFields = make_fields_res([{<<"apiversion">>, <<"0">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% apione
+
+adhoc_apione(Config) ->
+    Node = <<"api-commands/command_test_apione">>,
+    ArgFields = make_fields_args([]),
+    ResFields = make_fields_res([{<<"apiversion">>, <<"1">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% integer
+
+adhoc_integer(Config) ->
+    Node = <<"api-commands/command_test_integer">>,
+    ArgFields = make_fields_args([{<<"arg_integer">>, <<"12345">>}]),
+    ResFields = make_fields_res([{<<"res_integer">>, <<"12345">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% string
+
+adhoc_string(Config) ->
+    Node = <<"api-commands/command_test_string">>,
+    ArgFields = make_fields_args([{<<"arg_string">>, <<"Some string.">>}]),
+    ResFields = make_fields_res([{<<"res_string">>, <<"Some string.">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% binary
+
+adhoc_binary(Config) ->
+    Node = <<"api-commands/command_test_binary">>,
+    ArgFields = make_fields_args([{<<"arg_binary">>, <<"Some binary.">>}]),
+    ResFields = make_fields_res([{<<"res_string">>, <<"Some binary.">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% tuple
+
+adhoc_tuple(Config) ->
+    Node = <<"api-commands/command_test_tuple">>,
+    ArgFields = make_fields_args([{<<"arg_tuple">>, <<"one:two:three">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok,
+            [{xdata_field,
+              <<"res_tuple">>,
+              'text-single',
+              <<"res_tuple">>,
+              false,
+              <<" {element1 : element2 : element3}">>,
+              [<<"one : two : three">>],
+              [],
+              []}]},
+           set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% list
+
+adhoc_list(Config) ->
+    Node = <<"api-commands/command_test_list">>,
+    ArgFields = make_fields_args([{<<"arg_list">>, [<<"one">>, <<"first">>, <<"primary">>]}]),
+    ResFields =
+        make_fields_res([{<<"res_list">>, lists:sort([<<"one">>, <<"first">>, <<"primary">>])}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% list_tuple
+
+adhoc_list_tuple(Config) ->
+    Node = <<"api-commands/command_test_list_tuple">>,
+    ArgFields =
+        make_fields_args([{<<"arg_list">>, [<<"one:uno">>, <<"two:dos">>, <<"three:tres">>]}]),
+    ResFields =
+        make_fields_res([{<<"res_list">>,
+                          lists:sort([<<"one : uno">>, <<"two : dos">>, <<"three : tres">>])}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% atom
+
+adhoc_atom(Config) ->
+    Node = <<"api-commands/command_test_atom">>,
+    ArgFields = make_fields_args([{<<"arg_string">>, <<"a_test_atom">>}]),
+    ResFields = make_fields_res([{<<"res_atom">>, <<"a_test_atom">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% rescode
+
+adhoc_rescode(Config) ->
+    Node = <<"api-commands/command_test_rescode">>,
+    ArgFields = make_fields_args([{<<"code">>, <<"ok">>}]),
+    ResFields = make_fields_res([{<<"res_atom">>, <<"0">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% restuple
+
+adhoc_restuple(Config) ->
+    Node = <<"api-commands/command_test_restuple">>,
+    ArgFields =
+        make_fields_args([{<<"code">>, <<"ok">>}, {<<"text">>, <<"Just a result text">>}]),
+    ResFields = make_fields_res([{<<"res_atom">>, <<"Just a result text">>}]),
+    {ok, Sid, _FormFields} = get_form(Config, Node),
+    ?match({ok, ResFields}, set_form(Config, Node, Sid, ArgFields)),
+    suite:disconnect(Config).
+
+%%% internal functions
+
+server_jid(Config) ->
+    jid:make(<<>>, ?config(server, Config), <<>>).
+
+make_fields_args(Fields) ->
+    lists:map(fun ({Var, Values}) when is_list(Values) ->
+                      #xdata_field{label = Var,
+                                   var = Var,
+                                   required = true,
+                                   type = 'text-multi',
+                                   values = Values};
+                  ({Var, Value}) ->
+                      #xdata_field{label = Var,
+                                   var = Var,
+                                   required = true,
+                                   type = 'text-single',
+                                   values = [Value]}
+              end,
+              Fields).
+
+make_fields_res(Fields) ->
+    lists:map(fun ({Var, Values}) when is_list(Values) ->
+                      #xdata_field{label = Var,
+                                   var = Var,
+                                   type = 'text-multi',
+                                   values = Values};
+                  ({Var, Value}) ->
+                      #xdata_field{label = Var,
+                                   var = Var,
+                                   type = 'text-single',
+                                   values = [Value]}
+              end,
+              Fields).
+
+get_form(Config, Node) ->
+    case suite:send_recv(Config,
+                         #iq{type = set,
+                             to = server_jid(Config),
+                             sub_els = [#adhoc_command{node = Node}]})
+    of
+        #iq{type = result,
+            sub_els =
+                [#adhoc_command{node = Node,
+                                action = execute,
+                                status = executing,
+                                sid = Sid,
+                                actions = #adhoc_actions{execute = complete, complete = true},
+                                xdata = #xdata{fields = Fields}}]} ->
+            {ok, Sid, [F || F <- Fields, F#xdata_field.type /= fixed]};
+        #iq{type = error} = Err ->
+            xmpp:get_error(Err)
+    end.
+
+set_form(Config, Node, Sid, ArgFields) ->
+    Xdata = #xdata{type = submit, fields = ArgFields},
+    case suite:send_recv(Config,
+                         #iq{type = set,
+                             to = server_jid(Config),
+                             sub_els =
+                                 [#adhoc_command{node = Node,
+                                                 action = complete,
+                                                 sid = Sid,
+                                                 xdata = Xdata}]})
+    of
+        #iq{type = result,
+            sub_els =
+                [#adhoc_command{node = Node,
+                                action = execute,
+                                status = completed,
+                                sid = Sid,
+                                xdata = #xdata{fields = ResFields}}]} ->
+            ResFields2 = [F || F <- ResFields, F#xdata_field.type /= fixed],
+            {ok, ResFields2 -- ArgFields};
+        #iq{type = error} = Err ->
+            xmpp:get_error(Err)
+    end.
+
 %%%==================================
 
 %%% vim: set foldmethod=marker foldmarker=%%%%,%%%=:

test/ejabberd_SUITE_data/ejabberd.yml

@@ -111,6 +111,7 @@ max_fsm_queue: 1000
 queue_type: file
 modules:
   mod_adhoc: []
+  mod_adhoc_api: []
   mod_admin_extra: []
   mod_admin_update_sql: []
   mod_announce: []