Merge branch '3.0.x' of github.com:processone/maincustomers into 3.0.x

It caused problem with presences send to conference rooms, as this change
made us not always send presence unavailable when user went offline, which
did make conference have phantom users.

This revert functional changes introduced in
e521c8368a

contrib/ejabberd-modules.repo

@@ -1,5 +0,0 @@
-% List of ejabberd-modules to add for ejabberd packaging (source archive and installer)
-%
-% HTTP-binding:
-%https://svn.process-one.net/ejabberd-modules/http_bind/trunk
-%https://svn.process-one.net/ejabberd-modules/mod_http_fileserver/trunk

doc/Makefile

@@ -21,10 +21,11 @@ release:
 	@echo "\newcommand{\version}{"`sed '/vsn/!d;s/\(.*\)"\(.*\)"\(.*\)/\2/' ../src/ejabberd.app`"}" >> version.tex
 	@echo -n "% Contributed modules (automatically generated)."  > contributed_modules.tex
 	@echo -e "$(CONTRIBUTED_MODULES)" >> contributed_modules.tex
+	@echo "% mod_admin_p1 commands list."
 
-html:	guide.html dev.html features.html
+html:	guide.html dev.html features.html commercial.html
 
-pdf:	guide.pdf features.pdf
+pdf:	guide.pdf features.pdf commercial.pdf
 
 clean:
 	rm -f *.aux
@@ -60,3 +61,15 @@ guide.pdf:	guide.tex
 
 features.pdf:	features.tex
 		pdflatex features.tex
+
+commercial.html: commercial.tex
+		./mod_admin_p1_commands.sh
+		hevea -fix -pedantic commercial.tex
+
+commercial.pdf:	commercial.tex
+		./mod_admin_p1_commands.sh
+		pdflatex commercial.tex
+		pdflatex commercial.tex
+		pdflatex commercial.tex
+		makeindex commercial.idx
+		pdflatex commercial.tex

doc/guide.html

@@ -1210,7 +1210,7 @@ attacks.
 </LI><LI CLASS="li-itemize">You may want to allow login access only for certain users. <TT>pam_listfile.so</TT>
 module provides such functionality.
 </LI><LI CLASS="li-itemize">If you use <TT>pam_winbind</TT> to authorise against a Windows Active Directory,
-then <TT>/etc/nssswitch.conf</TT> must be configured to use <TT>winbind</TT> as well.
+then <TT>/etc/nsswitch.conf</TT> must be configured to use <TT>winbind</TT> as well.
 </LI></UL><P> <A NAME="accessrules"></A> </P><!--TOC subsection Access Rules-->
 <H3 CLASS="subsection"><!--SEC ANCHOR --><A NAME="htoc25">3.1.5</A>&#XA0;&#XA0;<A HREF="#accessrules">Access Rules</A></H3><!--SEC END --><P> <A NAME="accessrules"></A> 
 </P><P> <A NAME="ACLDefinition"></A> </P><!--TOC subsubsection ACL Definition-->
@@ -4499,7 +4499,7 @@ Alexey Shchepin (<A HREF="xmpp:aleksey@jabber.ru"><TT>xmpp:aleksey@jabber.ru</TT
 </LI><LI CLASS="li-itemize">Vsevolod Pelipas (<A HREF="xmpp:vsevoload@jabber.ru"><TT>xmpp:vsevoload@jabber.ru</TT></A>)
 </LI></UL><P> <A NAME="copyright"></A> </P><!--TOC chapter Copyright Information-->
 <H1 CLASS="chapter"><!--SEC ANCHOR --><A NAME="htoc103">Appendix&#XA0;D</A>&#XA0;&#XA0;<A HREF="#copyright">Copyright Information</A></H1><!--SEC END --><P> <A NAME="copyright"></A> </P><P>Ejabberd Installation and Operation Guide.<BR>
-Copyright &#XA9; 2003 &#X2014; 2012 ProcessOne</P><P>This document is free software; you can redistribute it and/or
+Copyright &#XA9; 2003 &#X2014; 2013 ProcessOne</P><P>This document 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.</P><P>This document is distributed in the hope that it will be useful,

doc/guide.tex

@@ -82,6 +82,7 @@
 \newcommand{\modmuc}{\module{mod\_muc}}
 \newcommand{\modmucodbc}{\module{mod\_muc\_odbc}}
 \newcommand{\modmuclog}{\module{mod\_muc\_log}}
+\newcommand{\modmulticast}{\module{mod\_multicast}}
 \newcommand{\modoffline}{\module{mod\_offline}}
 \newcommand{\modofflineodbc}{\module{mod\_offline\_odbc}}
 \newcommand{\modping}{\module{mod\_ping}}
@@ -253,6 +254,8 @@ go to the Windows service settings and set ejabberd to be automatically started.
 Note that the Windows service is a feature still in development,
 and for example it doesn't read the file ejabberdctl.cfg.
 
+The OSX binary installer works on OSX 10.6 and newer.
+
 On a *nix system, if you want ejabberd to be started as daemon at boot time,
 copy \term{ejabberd.init} from the 'bin' directory to something like \term{/etc/init.d/ejabberd}
 (depending on your distribution).
@@ -398,6 +401,9 @@ Some options that you may be interested in modifying:
 	\titem{--enable-nif}
         Replaces some critical Erlang functions with equivalents written in C to improve performance.
         This feature requires Erlang/OTP R13B04 or higher.
+
+	\titem{--enable-flash-hack}
+	Enable support for non-standard XML socket clients of Adobe Flash 8 and lower.
 \end{description}
 
 \makesubsection{install}{Install}
@@ -834,6 +840,9 @@ The available modules, their purpose and the options allowed by each one are:
     Handles incoming HTTP connections.\\
     Options: \texttt{captcha}, \texttt{certfile}, \texttt{default\_host}, \texttt{http\_bind}, \texttt{http\_poll},
     \texttt{request\_handlers}, \texttt{tls}, \texttt{trusted\_proxies}, \texttt{web\_admin}\\
+  \titem{\texttt{ejabberd\_xmlrpc}}
+    Handles incoming XML-RPC requests to execute ejabberd commands (see \ref{eja-commands}).\\
+    Options: \texttt{access\_commands}, \texttt{timeout}\\
 \end{description}
 
 
@@ -843,6 +852,19 @@ This is a detailed description of each option allowed by the listening modules:
 \begin{description}
   \titem{\{access, AccessName\}} \ind{options!access}This option defines
     access to the port. The default value is \term{all}.
+  \titem{\{access\_commands, AccessCommands\}} \ind{options!accesscommands}
+    This option allows to define a list of access restrictions (see \ref{accesscommands}).
+    If this option is present, then XML-RPC calls must include as
+    first argument a struct with a user, server and password of an
+    account in ejabberd that has privileges in Access.
+    If the option is not present, such struct must not be provided.
+    The default value is to not define any restriction: \term{\[\]}
+    When one or several access restrictions are defined and the
+    XML-RPC call provides authentication for an account, each
+    restriction is verified until one matches completely:
+    the account matches the Access rule,
+    the command name is listed in CommandNames,
+    and the provided arguments do not contradict Arguments.
   \titem{\{backlog, Value\}} \ind{options!backlog}The backlog value
     defines the maximum length that the queue of pending connections may
     grow to. This should be increased if the server is going to handle
@@ -950,6 +972,9 @@ This is a detailed description of each option allowed by the listening modules:
     No unencrypted connections will be allowed.
     You should also set the \option{certfile} option.
     You can define a certificate file for a specific domain using the global option \option{domain\_certfile}.
+  \titem{\{timeout, Integer\}} \ind{options!timeout}
+    Timeout of the connections, expressed in milliseconds.
+    Default: 5000
   \titem{tls} \ind{options!tls}\ind{TLS}This option specifies that traffic on
     the port will be encrypted using SSL immediately after connecting.
     This was the traditional encryption method in the early Jabber software,
@@ -1096,6 +1121,8 @@ In this example, the following configuration defines that:
   example in section~\ref{webadmin} shows how exactly this can be done.
 \item All users except for the administrators have a traffic of limit 
   1,000\,Bytes/second
+\item The XML-RPC service listens in port 4560 and allows only
+  a specific account, to request registrations and unregistrations in a specific host.
 \item \ind{transports!AIM}The
   \footahref{http://www.ejabberd.im/pyaimt}{AIM transport}
   \jid{aim.example.org} is connected to port 5233 on localhost IP addresses
@@ -1126,6 +1153,8 @@ In this example, the following configuration defines that:
 {shaper, normal, {maxrate, 1000}}.
 {access, c2s_shaper, [{none, admin},
                       {normal, all}]}.
+{acl, xmlrpc_bot, {user, "xmlrpc-robot", "example.org"}}.
+{access, xmlrpc_access, [{allow, xmlrpc_bot}]}.
 {listen,
  [{5222, ejabberd_c2s, [
                         {access, c2s},
@@ -1145,6 +1174,11 @@ In this example, the following configuration defines that:
                                          http_poll,
                                          web_admin
                                         ]},
+  {4560, ejabberd_xmlrpc, [
+                           {access_commands, [
+                             {xmlrpc_access, [register, unregister], [{host, "example.org"}]}
+                           ]}
+                          ]},
   {{5233, {127, 0, 0, 1}}, ejabberd_service, [
                                               {hosts, ["aim.example.org"],
                                                  [{password, "aimsecret"}]}
@@ -1241,7 +1275,7 @@ The option \option{fqdn} allows you to define the Fully Qualified Domain Name
 of the machine, in case it isn't detected automatically.
 The FQDN is used to authenticate some clients that use the DIGEST-MD5 SASL mechanism.
 The option syntax is:
-\esyntax{\{fqdn, undefined|FqdnString\}.}
+\esyntax{\{fqdn, undefined|FqdnString|[FqdnString]\}.}
 
 \makesubsubsection{internalauth}{Internal}
 \ind{internal authentication}\ind{Mnesia}
@@ -1451,7 +1485,7 @@ attacks.
 \item You may want to allow login access only for certain users. \term{pam\_listfile.so}
 module provides such functionality.
 \item If you use \term{pam\_winbind} to authorise against a Windows Active Directory,
-then \term{/etc/nssswitch.conf} must be configured to use \term{winbind} as well.
+then \term{/etc/nsswitch.conf} must be configured to use \term{winbind} as well.
 \end{itemize}
 
 \makesubsection{accessrules}{Access Rules}
@@ -2067,9 +2101,19 @@ enabled. This can be done, by using next commands:
 \makesubsubsection{configuremssql}{Database Connection}
 \ind{Microsoft SQL Server!Database Connection}
 
-The configuration of Database Connection for a Microsoft SQL Server
-is the same as the configuration for
-ODBC compatible servers (see section~\ref{configureodbc}).
+By default \ejabberd{} opens 10 connections to the database for each virtual host.
+Use this option to modify the value:
+\begin{verbatim}
+{odbc_pool_size, 10}.
+\end{verbatim}
+
+You can configure an interval to make a dummy SQL request
+to keep alive the connections to the database.
+The default value is 'undefined', so no keepalive requests are made.
+Specify in seconds: for example 28800 means 8 hours.
+\begin{verbatim}
+{odbc_keepalive_interval, undefined}.
+\end{verbatim}
 
 
 \makesubsubsection{mssqlauth}{Authentication}
@@ -2077,8 +2121,7 @@ ODBC compatible servers (see section~\ref{configureodbc}).
 
 %TODO: not sure if this section is right!!!!!!
 
-The configuration of Authentication for a Microsoft SQL Server
-is the same as the configuration for
+The configuration of Microsoft SQL Server is the same as the configuration of
 ODBC compatible servers (see section~\ref{odbcauth}).
 
 \makesubsubsection{mssqlstorage}{Storage}
@@ -2601,6 +2644,7 @@ The following table lists all modules included in \ejabberd{}.
     \hline \ahrefloc{modmuc}{\modmuc{}} & Multi-User Chat (\xepref{0045}) &  \\
     \hline \ahrefloc{modmuc}{\modmucodbc{}} & Multi-User Chat (\xepref{0045}) & supported DB (*) \\
     \hline \ahrefloc{modmuclog}{\modmuclog{}} & Multi-User Chat room logging & \modmuc{} or \modmucodbc{} \\
+    \hline \ahrefloc{modmulticast}{\modmulticast{}} & Multicast service (\xepref{0033}) &  \\
     \hline \ahrefloc{modoffline}{\modoffline{}} & Offline message storage (\xepref{0160}) &  \\
     \hline \ahrefloc{modoffline}{\modofflineodbc{}} & Offline message storage (\xepref{0160}) & supported DB (*) \\
     \hline \ahrefloc{modping}{\modping{}} & XMPP Ping and periodic keepalives (\xepref{0199}) &  \\
@@ -3562,6 +3606,56 @@ Examples:
 \end{verbatim}
 \end{itemize}
 
+\makesubsection{modmulticast}{\modmulticast{}}
+\ind{modules!\modmulticast{}}
+
+This module implements Extended Stanza Addressing (\xepref{0033}).
+
+\begin{description}
+ \hostitem{multicast}
+ \titem{\{access, AccessName\}}\ind{options!access}
+  This option specifies the access rule that defines who can send packets to the multicast service.
+  The default value is \term{all}.
+ \titem{\{limits, [\{SenderType, StanzaType, Number\}]\}}\ind{options!limits}
+  Specify a list of custom limits which override the default ones defined
+  in (\xepref{0033}).
+  Where:
+  \begin{itemize}
+   \item SenderType can have values: local or remote.
+   \item StanzaType can have values: message or presence.
+   \item Number can be a positive integer or the key word infinite.
+  \end{itemize}
+  The default value is \term{[]}.
+\end{description}
+
+Example configuration:
+\begin{verbatim}
+%% Only admins can send packets to multicast service
+{access, multicast, [{allow, admin}, {deny, all}]}.
+
+%% If you want to allow all your users:
+%%{access, multicast, [{allow, all}]}.
+
+%% This allows both admins and remote users to send packets,
+%% but does not allow local users
+%%{acl, allservers, {server_glob, "*"}}.
+%%{access, multicast, [{allow, admin}, {deny, local}, {allow, allservers}]}.
+
+{modules, [
+  ...
+  {mod_multicast, [
+     %%{host, "multicast.@HOST@"},
+     {access, multicast},
+     {limits, [
+       {local, message, 40},
+       {local, presence, infinite},
+       {remote, message, 150}
+     ]}
+  ]},
+  ...
+]}.
+\end{verbatim}
+
 \makesubsection{modoffline}{\modoffline{}}
 \ind{modules!\modoffline{}}
 
@@ -5125,9 +5219,10 @@ with a defined number and type of calling arguments and type of result
 that is registered in the \term{ejabberd\_commands} service.
 Those commands can be defined in any Erlang module and executed using any valid frontend.
 
-\ejabberd{} includes a frontend to execute \term{ejabberd commands}: the script \term{ejabberdctl}.
+\ejabberd{} includes two frontends to execute \term{ejabberd commands}:
+the \term{ejabberdctl} shell script (see \ref{ejabberdctl})
+and the \term{ejabberd\_xmlrpc} XML-RPC listener (see \ref{listened-module}).
 Other known frontends that can be installed to execute ejabberd commands in different ways are:
-\term{ejabberd\_xmlrpc} (XML-RPC service),
 \term{mod\_rest} (HTTP POST service),
 \term{mod\_shcommands} (ejabberd WebAdmin page).
 
@@ -5185,6 +5280,8 @@ The most interesting ones are:
   from other Jabber/XMPP servers
   There exist tutorials to
   \footahref{http://www.ejabberd.im/migrate-to-ejabberd}{migrate from other software to ejabberd}.
+\titem{export\_odbc virtualhost filename} \ind{export mnesia data to a SQL file}
+  Export virtual host information from Mnesia tables to a SQL file.
 \titem{delete\_expired\_messages} This option can be used to delete old messages
   in offline storage. This might be useful when the number of offline messages
   is very high.
@@ -5917,7 +6014,7 @@ Thanks to all people who contributed to this guide:
 \makechapter{copyright}{Copyright Information}
 
 Ejabberd Installation and Operation Guide.\\
-Copyright \copyright{} 2003 --- 2012 ProcessOne
+Copyright \copyright{} 2003 --- 2013 ProcessOne
 
 This document is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public License

doc/http_post.md

@@ -0,0 +1,146 @@
+# Managing pubsub nodes through HTTP Atompub #
+
+
+## Configuration ##
+	
+These options will be used by the service to know how to build URLs. Using the previous configuration items the service should be accessed through `http://notify.push.bbc.co.uk:5280/pshb/<host>/<node>/`.
+
+Also, in the ejabberd_http handler configuration, add the identified line.
+
+	{5280, ejabberd_http, [
+		 http_poll, 
+		 web_admin,
+		 {request_handlers, [{["pshb"], pshb_http}]} % this should be added
+	]}
+
+It will automatically detect the version of mod_pubsub (odbc or mnesia) and call the appropriate module.
+
+## Important notice ##
+
+In the current version of the code, some security checks are not done :
+
+ * node creation uses the default `all` access_createnode acl, not checking for the actual configuration.
+
+ * most read operations are successfully executed without authentication. HOWEVER listing items can only be done when the node access_model is "open". In all other cases, the service returns 403. A finer grained authentication will be implemented.
+
+
+## Usage example with cURL ##
+
+### Errors ###
+
+HTTP status codes are used as intended. Additionally, the XMPP error stanza can also be set in the body :
+
+	$ curl -i -X POST -u cstar@localhost:encore -d @createnode.xml http://localhost:5280/pshb/localhost
+	HTTP/1.1 409 Conflict
+	Content-Type: text/html; charset=utf-8
+	Content-Length: 95
+	Content-type: application/xml
+	
+	<error code='409' type='cancel'><conflict xmlns='urn:ietf:params:xml:ns:xmpp-stanzas'/></error>
+
+or
+
+	$ curl -i -X DELETE -u cstar@localhost:encore http://localhost:5280/pshb/localhost/princely_musings
+	HTTP/1.1 404 Not Found
+	Content-Type: text/html; charset=utf-8
+	Content-Length: 101
+	Content-type: application/xml
+
+	<error code='404' type='cancel'><item-not-found xmlns='urn:ietf:params:xml:ns:xmpp-stanzas'/></error>
+
+### Getting the service document ###
+
+No authentication necessary. All nodes are listed.
+
+ $ curl -i http://host:port/pshb/domain/
+	
+### Getting items from a node ###
+
+No authentication done, and all nodes are accessible.
+
+ $ curl -i http://host:port/pshb/domain/node/
+
+
+### Posting a new item ###
+
+	$ curl -u jid:password -i -X POST -d @entry.atom http://post:port/pshb/domain/node 
+	
+User ability to post is based on node configuration.
+
+### Editing a new item ###
+
+	$ curl -u jid:password -i -X POST -d @entry.atom http://post:port/pshb/domain/node/itemid 
+	
+User ability to post is based on node configuration.
+
+### Deleting an item ###
+
+	$ curl -u jid:password -i -X DELETE http://post:port/pshb/domain/node/itemid 
+	
+User ability to post is based on node configuration.
+
+
+### Creating a new node ###
+
+An instant node can be created if server configuration allows:
+
+	$ curl -X POST -u cstar@localhost:encore -d "" http://localhost:5280/pshb/localhost
+	
+or
+
+	$ curl -X POST -u cstar@localhost:encore -d "<pubsub><create node='princely_musings'/></pubsub>" http://localhost:5280/pshb/localhost
+	
+configure element (as per XEP-60) can be passed in the pubsub body.
+	
+	$ cat createnode.xml
+	<pubsub><create node='princely_musings' type='flat'/>
+	<x xmlns='jabber:x:data' type='submit'>
+	  <field var='FORM_TYPE' type='hidden'>
+	    <value>http://jabber.org/protocol/pubsub#node_config</value>
+	  </field>
+	  <field var='pubsub#title'><value>Princely Musings (Atom)</value></field>
+	  <field var='pubsub#max_payload_size'><value>1028</value></field>
+	  <field var='pubsub#type'><value>Atom</value></field>
+	</x>
+	</pubsub>
+	
+	$ curl -i -X POST -u cstar@localhost:encore -d @createnode.xml http://localhost:5280/pshb/localhost
+	HTTP/1.1 200 OK
+	Content-Length: 130
+	Content-Type: application/xml
+
+	<?xml version="1.0" encoding="utf-8"?><pubsub xmlns='http://jabber.org/protocol/pubsub'><create node='princely_musings'/></pubsub>
+	
+### Editing a node configuration ###
+
+	$ cat editnode.xml
+	<pubsub xmlns='http://jabber.org/protocol/pubsub#owner'>
+	    <configure node='princely_musings'>
+	      <x xmlns='jabber:x:data' type='submit'>
+	        <field var='FORM_TYPE' type='hidden'>
+	          <value>http://jabber.org/protocol/pubsub#node_config</value>
+	        </field>
+	        <field var='pubsub#title'><value>Princely Musings (Atom)</value></field>
+	        <field var='pubsub#deliver_notifications'><value>1</value></field>
+	        <field var='pubsub#deliver_payloads'><value>1</value></field>
+	        <field var='pubsub#persist_items'><value>1</value></field>
+	        <field var='pubsub#max_items'><value>10</value></field>
+	        <field var='pubsub#item_expire'><value>604800</value></field>
+	        <field var='pubsub#access_model'><value>roster</value></field>
+				</x>
+			</configure>
+		</pubsub>
+		
+
+	$ curl -i -X PUT -u cstar@localhost:encore -d @createnode.xml http://localhost:5280/pshb/localhost/princely_musings
+	
+	
+	
+### Deleting a node ###
+
+A node is deleted by: 
+
+	$ curl -X DELETE -u cstar@localhost:encore http://localhost:5280/pshb/localhost/princely_musings
+
+
+

doc/mod_admin_p1_commands.sh

@@ -0,0 +1,99 @@
+#!/usr/bin/env escript
+%% -*- erlang -*-
+
+-record(cmd, {name, desc, longdesc, args, result}).
+
+main(_) ->
+    Dir = filename:absname(filename:join(["..", "src"])),
+    FileIn = filename:join([Dir, "mod_admin_p1.erl"]),
+    {ok, Forms1} = epp_dodger:parse_file(FileIn, [no_fail]),
+    Comments = erl_comment_scan:file(FileIn),
+    Forms = erl_recomment:recomment_forms(Forms1, Comments),
+    Tree = erl_syntax:flatten_form_list(Forms),
+    AuxFile = "mod_admin.tex",
+    case file:open(AuxFile, [write]) of
+        {ok, Fd} ->
+            io:format(Fd, "\\newcommand{\\modadminsection}{\\begin{description}~n", []),
+            process(Fd, Tree),
+            io:format(Fd, "\\end{description}}~n", []),
+            file:close(Fd),
+            halt(0);
+        {error, Why} ->
+            io:format("failed to open file ~s: ~s",
+                      [AuxFile, file:format_error(Why)]),
+            halt(1)
+    end.
+
+process(Fd, Tree) ->
+    case erl_syntax:type(Tree) of
+        record_expr ->
+            case erl_syntax_lib:analyze_record_expr(Tree) of
+                {record_expr, {ejabberd_commands, _}} ->
+                    Fs = erl_syntax:record_expr_fields(Tree),
+                    Cmd = lists:foldl(
+                            fun(F, C) ->
+                                    Name = erl_syntax:record_field_name(F),
+                                    Value = erl_syntax:record_field_value(F),
+                                    case {erl_syntax:concrete(Name),
+                                          catch erl_syntax:concrete(Value)} of
+                                        {_, {'EXIT', _}} ->
+                                            C;
+                                        {name, V} ->
+                                            C#cmd{name = V};
+                                        {desc, V} ->
+                                            C#cmd{desc = V};
+                                        {longdesc, V} ->
+                                            C#cmd{longdesc = V};
+                                        {args, V} ->
+                                            C#cmd{args = V};
+                                        {result, V} ->
+                                            C#cmd{result = V};
+                                        _ ->
+                                            C
+                                    end
+                            end, #cmd{}, Fs),
+                    format_command(Fd, Cmd);
+                _ ->
+                    ok
+            end;
+        _ ->
+            case erl_syntax:subtrees(Tree) of
+                [] ->
+                    ok;
+                List ->
+                    lists:foreach(
+                      fun(Group) ->
+                              lists:foreach(
+                                fun(Subtree) ->
+                                        process(Fd, Subtree)
+                                end, Group)
+                      end, List)
+            end
+    end.
+
+-define(B(S), S).
+
+format_command(Fd, #cmd{name = Cmd,
+                        desc = Desc,
+                        longdesc = _LongDesc,
+                        args = ArgsDef,
+                        result = _ResultDef}) ->
+    io:format(Fd, "\\titem{~s ~s} ~s~n",
+              [escape_underscores(atom_to_list(Cmd)),
+               flatten_arguments(ArgsDef),
+               escape_underscores(Desc)]).
+
+flatten_arguments(Args) ->
+    string:join(
+      lists:map(
+        fun({Name, _Type}) ->
+                escape_underscores(io_lib:format("~s", [Name]))
+        end, Args),
+      " ").
+
+escape_underscores(S) ->
+    lists:flatten(
+      [case C of
+           $_ -> "\\_";
+           _ -> C
+       end || C <- S]).

doc/version.tex

@@ -1,2 +1,2 @@
 % ejabberd version (automatically generated).
-\newcommand{\version}{2.1.11}
+\newcommand{\version}{3.0.0}

src/Makefile.in

@@ -35,7 +35,7 @@ ERLANG_CFLAGS += @ERLANG_SSLVER@
 
 # make debug=true to compile Erlang module with debug informations.
 ifdef debug
-  EFLAGS+=+debug_info +export_all
+  EFLAGS+=+debug_info
 endif
 
 DEBUGTOOLS = p1_prof.erl
@@ -74,12 +74,17 @@ ifeq (@pam@, pam)
   INSTALL_EPAM=install -m 750 $(O_USER) epam $(PBINDIR)
 endif
 
+ifeq (@flash_hack@, true)
+  ERLC_FLAGS+=-DENABLE_FLASH_HACK
+  CPPFLAGS+=-DENABLE_FLASH_HACK
+endif
+
 prefix = @prefix@
 exec_prefix = @exec_prefix@
 
 SUBDIRS = @mod_irc@ @mod_pubsub@ @mod_muc@ @mod_proxy65@ @eldap@ @pam@ @web@ stringprep stun @tls@ @odbc@ @ejabberd_zlib@
 ERLSHLIBS += expat_erl.so
-ERLBEHAVS = cyrsasl.erl gen_mod.erl p1_fsm.erl
+ERLBEHAVS = cyrsasl.erl gen_mod.erl p1_fsm.erl ejabberd_auth.erl
 SOURCES_ALL = $(wildcard *.erl)
 SOURCES_MISC = $(ERLBEHAVS) $(DEBUGTOOLS)
 SOURCES += $(filter-out $(SOURCES_MISC),$(SOURCES_ALL))
@@ -168,7 +173,7 @@ mostlyclean-recursive maintainer-clean-recursive:
 	@ERLC@ -W $(EFLAGS) $*.erl
 
 $(ERLSHLIBS):	%.so:	%.c
-	$(CC) $(CFLAGS) $(LDFLAGS) $(LIBS) \
+	$(CC) $(CFLAGS) $(CPPFLAGS) $(LDFLAGS) $(LIBS) \
 		$(subst ../,,$(subst .so,.c,$@)) \
 		$(EXPAT_LIBS) \
 		$(EXPAT_CFLAGS) \
@@ -227,6 +232,8 @@ install: all
 	install -m 644 mod_proxy65/*.hrl $(INCLUDEDIR)/mod_proxy65/
 	install -d $(INCLUDEDIR)/mod_pubsub/
 	install -m 644 mod_pubsub/*.hrl $(INCLUDEDIR)/mod_pubsub/
+	install -d $(INCLUDEDIR)/mod_pubsub_ng/
+	install -m 644 mod_pubsub_ng/*.hrl $(INCLUDEDIR)/mod_pubsub_ng/
 	install -d $(INCLUDEDIR)/web/
 	install -m 644 web/*.hrl $(INCLUDEDIR)/web/
 	#

src/Makefile.win32

@@ -59,6 +59,8 @@ release : build release_clean
 	copy mod_muc\*.erl $(SRC_DIR)\mod_muc
 	mkdir $(SRC_DIR)\mod_pubsub
 	copy mod_pubsub\*.erl $(SRC_DIR)\mod_pubsub
+	mkdir $(SRC_DIR)\mod_pubsub_ng
+	copy mod_pubsub_ng\*.erl $(SRC_DIR)\mod_pubsub_ng
 	mkdir $(SRC_DIR)\mod_proxy65
 	copy mod_proxy65\*.erl $(SRC_DIR)\mod_proxy65
 	copy mod_proxy65\*.hrl $(SRC_DIR)\mod_proxy65
@@ -100,6 +102,8 @@ all-recursive :
 	nmake -nologo -f Makefile.win32
 	cd ..\mod_pubsub
 	nmake -nologo -f Makefile.win32
+	cd ..\mod_pubsub_ng
+	nmake -nologo -f Makefile.win32
 	cd ..\mod_proxy65
 	nmake -nologo -f Makefile.win32
 	cd ..\stringprep
@@ -143,6 +147,8 @@ clean-recursive :
 	nmake -nologo -f Makefile.win32 clean
 	cd ..\mod_pubsub
 	nmake -nologo -f Makefile.win32 clean
+	cd ..\mod_pubsub_ng
+	nmake -nologo -f Makefile.win32 clean
 	cd ..\mod_proxy65
 	nmake -nologo -f Makefile.win32 clean
 	cd ..\stringprep

src/acl.erl

@@ -5,7 +5,7 @@
 %%% Created : 18 Jan 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,225 +25,264 @@
 %%%----------------------------------------------------------------------
 
 -module(acl).
+
 -author('alexey@process-one.net').
 
--export([start/0,
-	 to_record/3,
-	 add/3,
-	 add_list/3,
-	 match_rule/3,
-	 % for debugging only
-	 match_acl/3]).
+-export([start/0, to_record/3, add/3, add_list/3,
+	 match_rule/3, match_acl/3]).
 
 -include("ejabberd.hrl").
+-include("jlib.hrl").
 
 -record(acl, {aclname, aclspec}).
 
+-type regexp() :: binary().
+-type glob() :: binary().
+-type aclname() :: {atom(), binary() | global}.
+-type aclspec() :: all | none |
+                   {user, binary()} |
+                   {user, binary(), binary()} |
+                   {server, binary()} |
+                   {resource, binary()} |
+                   {user_regexp, regexp()} |
+                   {shared_group, binary()} |
+                   {shared_group, binary(), binary()} |
+                   {user_regexp, regexp(), binary()} |
+                   {server_regexp, regexp()} |
+                   {resource_regexp, regexp()} |
+                   {node_regexp, regexp(), regexp()} |
+                   {user_glob, glob()} |
+                   {user_glob, glob(), binary()} |
+                   {server_glob, glob()} |
+                   {resource_glob, glob()} |
+                   {node_glob, glob(), glob()}.
+
+-type acl() :: #acl{aclname :: aclname(),
+                    aclspec :: aclspec()}.
+
+-export_type([acl/0]).
+
 start() ->
     mnesia:create_table(acl,
-			[{disc_copies, [node()]},
-			 {type, bag},
+			[{disc_copies, [node()]}, {type, bag},
 			 {attributes, record_info(fields, acl)}]),
     mnesia:add_table_copy(acl, node(), ram_copies),
+    update_table(),
     ok.
 
+-spec to_record(binary(), atom(), aclspec()) -> acl().
+
 to_record(Host, ACLName, ACLSpec) ->
-    #acl{aclname = {ACLName, Host}, aclspec = normalize_spec(ACLSpec)}.
+    #acl{aclname = {ACLName, Host},
+	 aclspec = normalize_spec(ACLSpec)}.
+
+-spec add(binary(), aclname(), aclspec()) -> {atomic, ok} | {aborted, any()}.
 
 add(Host, ACLName, ACLSpec) ->
-    F = fun() ->
+    F = fun () ->
 		mnesia:write(#acl{aclname = {ACLName, Host},
 				  aclspec = normalize_spec(ACLSpec)})
 	end,
     mnesia:transaction(F).
 
+-spec add_list(binary(), [acl()], boolean()) -> false | ok.
+
 add_list(Host, ACLs, Clear) ->
-    F = fun() ->
-		if
-		    Clear ->
-			Ks = mnesia:select(
-			       acl, [{{acl, {'$1', Host}, '$2'}, [], ['$1']}]),
-			lists:foreach(fun(K) ->
-					      mnesia:delete({acl, {K, Host}})
-				      end, Ks);
-		    true ->
-			ok
+    F = fun () ->
+		if Clear ->
+		       Ks = mnesia:select(acl,
+					  [{{acl, {'$1', Host}, '$2'}, [],
+					    ['$1']}]),
+		       lists:foreach(fun (K) -> mnesia:delete({acl, {K, Host}})
+				     end,
+				     Ks);
+		   true -> ok
 		end,
-		lists:foreach(fun(ACL) ->
+		lists:foreach(fun (ACL) ->
 				      case ACL of
-					  #acl{aclname = ACLName,
-					       aclspec = ACLSpec} ->
-					      mnesia:write(
-						#acl{aclname = {ACLName, Host},
-						     aclspec = normalize_spec(ACLSpec)})
+					#acl{aclname = ACLName,
+					     aclspec = ACLSpec} ->
+					    mnesia:write(#acl{aclname =
+								  {ACLName,
+								   Host},
+							      aclspec =
+								  normalize_spec(ACLSpec)})
 				      end
-			      end, ACLs)
+			      end,
+			      ACLs)
 	end,
     case mnesia:transaction(F) of
-	{atomic, _} ->
-	    ok;
-	_ ->
-	    false
+      {atomic, _} -> ok;
+      _ -> false
     end.
 
-normalize(A) ->
-    jlib:nodeprep(A).
-normalize_spec({A, B}) ->
-    {A, normalize(B)};
+normalize(A) -> jlib:nodeprep(iolist_to_binary(A)).
+
+normalize_spec({A, B}) -> {A, normalize(B)};
 normalize_spec({A, B, C}) ->
     {A, normalize(B), normalize(C)};
-normalize_spec(all) ->
-    all;
-normalize_spec(none) ->
-    none.
-
+normalize_spec(all) -> all;
+normalize_spec(none) -> none.
 
+-spec match_rule(global | binary(), atom(), jid() | ljid()) -> any().
 
 match_rule(global, Rule, JID) ->
     case Rule of
-	all -> allow;
-	none -> deny;
-	_ ->
-	    case ejabberd_config:get_global_option({access, Rule, global}) of
-		undefined ->
-		    deny;
-		GACLs ->
-		    match_acls(GACLs, JID, global)
-	    end
+      all -> allow;
+      none -> deny;
+      _ ->
+	  case ejabberd_config:get_global_option(
+                 {access, Rule, global}, fun(V) -> V end)
+	      of
+	    undefined -> deny;
+	    GACLs -> match_acls(GACLs, JID, global)
+	  end
     end;
-
 match_rule(Host, Rule, JID) ->
     case Rule of
-	all -> allow;
-	none -> deny;
-	_ ->
-	    case ejabberd_config:get_global_option({access, Rule, global}) of
-		undefined ->
-		    case ejabberd_config:get_global_option({access, Rule, Host}) of
-			undefined ->
-			    deny;
-			ACLs ->
-			    match_acls(ACLs, JID, Host)
-		    end;
-		GACLs ->
-		    case ejabberd_config:get_global_option({access, Rule, Host}) of
-			undefined ->
-			    match_acls(GACLs, JID, Host);
-			ACLs ->
-			    case lists:reverse(GACLs) of
-				[{allow, all} | Rest] ->
-				    match_acls(
-				      lists:reverse(Rest) ++ ACLs ++
-				      [{allow, all}],
-				      JID, Host);
-				_ ->
-				    match_acls(GACLs ++ ACLs, JID, Host)
-			    end
-		    end
-	    end
+      all -> allow;
+      none -> deny;
+      _ ->
+	  case ejabberd_config:get_global_option(
+                 {access, Rule, global}, fun(V) -> V end)
+	      of
+	    undefined ->
+		case ejabberd_config:get_global_option(
+                       {access, Rule, Host}, fun(V) -> V end)
+		    of
+		  undefined -> deny;
+		  ACLs -> match_acls(ACLs, JID, Host)
+		end;
+	    GACLs ->
+		case ejabberd_config:get_global_option(
+                       {access, Rule, Host}, fun(V) -> V end)
+		    of
+		  undefined -> match_acls(GACLs, JID, Host);
+		  ACLs ->
+		      case lists:reverse(GACLs) of
+			[{allow, all} | Rest] ->
+			    match_acls(lists:reverse(Rest) ++
+					 ACLs ++ [{allow, all}],
+				       JID, Host);
+			_ -> match_acls(GACLs ++ ACLs, JID, Host)
+		      end
+		end
+	  end
     end.
 
-match_acls([], _, _Host) ->
-    deny;
+match_acls([], _, _Host) -> deny;
 match_acls([{Access, ACL} | ACLs], JID, Host) ->
     case match_acl(ACL, JID, Host) of
-	true ->
-	    Access;
-	_ ->
-	    match_acls(ACLs, JID, Host)
+      true -> Access;
+      _ -> match_acls(ACLs, JID, Host)
     end.
 
+-spec match_acl(atom(), jid() | ljid(), binary()) -> boolean().
+
 match_acl(ACL, JID, Host) ->
     case ACL of
-	all -> true;
-	none -> false;
-	_ ->
-	    {User, Server, Resource} = jlib:jid_tolower(JID),
-	    lists:any(fun(#acl{aclspec = Spec}) ->
-			      case Spec of
-				  all ->
-				      true;
-				  {user, U} ->
-				      (U == User)
-					  andalso
-					    ((Host == Server) orelse
-					     ((Host == global) andalso
-					      lists:member(Server, ?MYHOSTS)));
-				  {user, U, S} ->
-				      (U == User) andalso (S == Server);
-				  {server, S} ->
-				      S == Server;
-				  {resource, R} ->
-				      R == Resource;
-				  {user_regexp, UR} ->
-				      ((Host == Server) orelse
-				       ((Host == global) andalso
-					lists:member(Server, ?MYHOSTS)))
-					  andalso is_regexp_match(User, UR);
-				  {shared_group, G} ->
-                                      Mod = loaded_shared_roster_module(Host),
-				      Mod:is_user_in_group({User, Server}, G, Host);
-				  {shared_group, G, H} ->
-                                      Mod = loaded_shared_roster_module(H),
-				      Mod:is_user_in_group({User, Server}, G, H);
-				  {user_regexp, UR, S} ->
-				      (S == Server) andalso
-					  is_regexp_match(User, UR);
-				  {server_regexp, SR} ->
-				      is_regexp_match(Server, SR);
-				  {resource_regexp, RR} ->
-				      is_regexp_match(Resource, RR);
-				  {node_regexp, UR, SR} ->
-				      is_regexp_match(Server, SR) andalso
-					  is_regexp_match(User, UR);
-				  {user_glob, UR} ->
-				      ((Host == Server) orelse
-				       ((Host == global) andalso
-					lists:member(Server, ?MYHOSTS)))
-					  andalso
-					  is_glob_match(User, UR);
-				  {user_glob, UR, S} ->
-				      (S == Server) andalso
-					  is_glob_match(User, UR);
-				  {server_glob, SR} ->
-				      is_glob_match(Server, SR);
-				  {resource_glob, RR} ->
-				      is_glob_match(Resource, RR);
-				  {node_glob, UR, SR} ->
-				      is_glob_match(Server, SR) andalso
-					  is_glob_match(User, UR);
-				  WrongSpec ->
-				      ?ERROR_MSG(
-					 "Wrong ACL expression: ~p~n"
-					 "Check your config file and reload it with the override_acls option enabled",
-					 [WrongSpec]),
-				      false
-			      end
-		      end,
-		      ets:lookup(acl, {ACL, global}) ++
+      all -> true;
+      none -> false;
+      _ ->
+	  {User, Server, Resource} = jlib:jid_tolower(JID),
+	  lists:any(fun (#acl{aclspec = Spec}) ->
+			    case Spec of
+			      all -> true;
+			      {user, U} ->
+				  U == User andalso
+				    (Host == Server orelse
+				       Host == global andalso
+					 lists:member(Server, ?MYHOSTS));
+			      {user, U, S} -> U == User andalso S == Server;
+			      {server, S} -> S == Server;
+			      {resource, R} -> R == Resource;
+			      {user_regexp, UR} ->
+				  (Host == Server orelse
+				     Host == global andalso
+				       lists:member(Server, ?MYHOSTS))
+				    andalso is_regexp_match(User, UR);
+			      {shared_group, G} ->
+				  Mod = loaded_shared_roster_module(Host),
+				  Mod:is_user_in_group({User, Server}, G, Host);
+			      {shared_group, G, H} ->
+				  Mod = loaded_shared_roster_module(H),
+				  Mod:is_user_in_group({User, Server}, G, H);
+			      {user_regexp, UR, S} ->
+				  S == Server andalso is_regexp_match(User, UR);
+			      {server_regexp, SR} ->
+				  is_regexp_match(Server, SR);
+			      {resource_regexp, RR} ->
+				  is_regexp_match(Resource, RR);
+			      {node_regexp, UR, SR} ->
+				  is_regexp_match(Server, SR) andalso
+				    is_regexp_match(User, UR);
+			      {user_glob, UR} ->
+				  (Host == Server orelse
+				     Host == global andalso
+				       lists:member(Server, ?MYHOSTS))
+				    andalso is_glob_match(User, UR);
+			      {user_glob, UR, S} ->
+				  S == Server andalso is_glob_match(User, UR);
+			      {server_glob, SR} -> is_glob_match(Server, SR);
+			      {resource_glob, RR} ->
+				  is_glob_match(Resource, RR);
+			      {node_glob, UR, SR} ->
+				  is_glob_match(Server, SR) andalso
+				    is_glob_match(User, UR);
+			      WrongSpec ->
+				  ?ERROR_MSG("Wrong ACL expression: ~p~nCheck your "
+					     "config file and reload it with the override_a"
+					     "cls option enabled",
+					     [WrongSpec]),
+				  false
+			    end
+		    end,
+		    ets:lookup(acl, {ACL, global}) ++
 		      ets:lookup(acl, {ACL, Host}))
     end.
 
 is_regexp_match(String, RegExp) ->
     case ejabberd_regexp:run(String, RegExp) of
-	nomatch ->
-	    false;
-	match ->
-	    true;
-	{error, ErrDesc} ->
-	    ?ERROR_MSG(
-	       "Wrong regexp ~p in ACL: ~p",
-	       [RegExp, ErrDesc]),
-	    false
+      nomatch -> false;
+      match -> true;
+      {error, ErrDesc} ->
+	  ?ERROR_MSG("Wrong regexp ~p in ACL: ~p",
+		     [RegExp, ErrDesc]),
+	  false
     end.
 
 is_glob_match(String, Glob) ->
-    is_regexp_match(String, ejabberd_regexp:sh_to_awk(Glob)).
+    is_regexp_match(String,
+		    ejabberd_regexp:sh_to_awk(Glob)).
 
 loaded_shared_roster_module(Host) ->
     case gen_mod:is_loaded(Host, mod_shared_roster_ldap) of
-        true ->
-            mod_shared_roster_ldap;
-        false ->
-            mod_shared_roster
+      true -> mod_shared_roster_ldap;
+      false -> mod_shared_roster
+    end.
+
+update_table() ->
+    Fields = record_info(fields, acl),
+    case mnesia:table_info(acl, attributes) of
+        Fields ->
+            ejabberd_config:convert_table_to_binary(
+              acl, Fields, bag,
+              fun(#acl{aclspec = Spec}) when is_tuple(Spec) ->
+                      element(2, Spec);
+                 (_) ->
+                      '$next'
+              end,
+              fun(#acl{aclname = {ACLName, Host},
+                       aclspec = Spec} = R) ->
+                      NewHost = if Host == global ->
+                                        Host;
+                                   true ->
+                                        iolist_to_binary(Host)
+                                end,
+                      R#acl{aclname = {ACLName, NewHost},
+                            aclspec = normalize_spec(Spec)}
+              end);
+        _ ->
+            ?INFO_MSG("Recreating acl table", []),
+            mnesia:transform_table(acl, ignore, Fields)
     end.

src/adhoc.erl

@@ -5,7 +5,7 @@
 %%% Created : 31 Oct 2005 by Magnus Henoch <henoch@dtek.chalmers.se>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,105 +25,128 @@
 %%%----------------------------------------------------------------------
 
 -module(adhoc).
+
 -author('henoch@dtek.chalmers.se').
 
--export([parse_request/1,
-	 produce_response/2,
-	 produce_response/1]).
+-export([
+    parse_request/1,
+    produce_response/2,
+    produce_response/1
+]).
 
 -include("ejabberd.hrl").
 -include("jlib.hrl").
 -include("adhoc.hrl").
 
-%% Parse an ad-hoc request.  Return either an adhoc_request record or
-%% an {error, ErrorType} tuple.
+%%
+-spec(parse_request/1 ::
+(
+  IQ :: iq_request())
+    -> adhoc_response()
+    %%
+     | {error, _}
+).
+
 parse_request(#iq{type = set, lang = Lang, sub_el = SubEl, xmlns = ?NS_COMMANDS}) ->
     ?DEBUG("entering parse_request...", []),
-    Node = xml:get_tag_attr_s("node", SubEl),
-    SessionID = xml:get_tag_attr_s("sessionid", SubEl),
-    Action = xml:get_tag_attr_s("action", SubEl),
+    Node = xml:get_tag_attr_s(<<"node">>, SubEl),
+    SessionID = xml:get_tag_attr_s(<<"sessionid">>, SubEl),
+    Action = xml:get_tag_attr_s(<<"action">>, SubEl),
     XData = find_xdata_el(SubEl),
-    {xmlelement, _, _, AllEls} = SubEl,
+    #xmlel{children = AllEls} = SubEl,
     Others = case XData of
-	false ->
-	    AllEls;
-	_ ->
-	    lists:delete(XData, AllEls)
+        false -> AllEls;
+        _     -> lists:delete(XData, AllEls)
     end,
+    #adhoc_request{
+        lang      = Lang,
+        node      = Node,
+        sessionid = SessionID,
+        action    = Action,
+        xdata     = XData,
+        others    = Others
+    };
+parse_request(_) -> {error, ?ERR_BAD_REQUEST}.
 
-    #adhoc_request{lang = Lang,
-		   node = Node,
-		   sessionid = SessionID,
-		   action = Action,
-		   xdata = XData,
-		   others = Others};
-parse_request(_) ->
-    {error, ?ERR_BAD_REQUEST}.
-
-%% Borrowed from mod_vcard.erl
-find_xdata_el({xmlelement, _Name, _Attrs, SubEls}) ->
+find_xdata_el(#xmlel{children = SubEls}) ->
     find_xdata_el1(SubEls).
 
-find_xdata_el1([]) ->
-    false;
-find_xdata_el1([{xmlelement, Name, Attrs, SubEls} | Els]) ->
-    case xml:get_attr_s("xmlns", Attrs) of
-	?NS_XDATA ->
-	    {xmlelement, Name, Attrs, SubEls};
-	_ ->
-	    find_xdata_el1(Els)
+find_xdata_el1([]) -> false;
+find_xdata_el1([El | Els]) when is_record(El, xmlel) ->
+    case xml:get_tag_attr_s(<<"xmlns">>, El) of
+        ?NS_XDATA -> El;
+        _         -> find_xdata_el1(Els)
     end;
-find_xdata_el1([_ | Els]) ->
-    find_xdata_el1(Els).
+find_xdata_el1([_ | Els]) -> find_xdata_el1(Els).
 
-%% Produce a <command/> node to use as response from an adhoc_response
-%% record, filling in values for language, node and session id from
-%% the request.
-produce_response(#adhoc_request{lang = Lang,
-				node = Node,
-				sessionid = SessionID},
-		 Response) ->
-    produce_response(Response#adhoc_response{lang = Lang,
-					     node = Node,
-					     sessionid = SessionID}).
+%%
+-spec(produce_response/2 ::
+(
+  Adhoc_Request  :: adhoc_request(),
+  Adhoc_Response :: adhoc_response())
+    -> Xmlel::xmlel()
+).
 
-%% Produce a <command/> node to use as response from an adhoc_response
-%% record.
-produce_response(#adhoc_response{lang = _Lang,
-				 node = Node,
-				 sessionid = ProvidedSessionID,
-				 status = Status,
-				 defaultaction = DefaultAction,
-				 actions = Actions,
-				 notes = Notes,
-				 elements = Elements}) ->
-    SessionID = if is_list(ProvidedSessionID), ProvidedSessionID /= "" ->
-			ProvidedSessionID;
-		   true ->
-			jlib:now_to_utc_string(now())
-		end,
+produce_response(#adhoc_request{lang = Lang, node = Node, sessionid = SessionID},
+  Adhoc_Response) ->
+    produce_response(Adhoc_Response#adhoc_response{
+        lang = Lang, node = Node, sessionid = SessionID
+    }).
+
+%%
+-spec(produce_response/1 ::
+(
+  Adhoc_Response::adhoc_response())
+    -> Xmlel::xmlel()
+).
+
+produce_response(
+  #adhoc_response{
+   %lang          = _Lang,
+    node          = Node,
+    sessionid     = ProvidedSessionID,
+    status        = Status,
+    defaultaction = DefaultAction,
+    actions       = Actions,
+    notes         = Notes,
+    elements      = Elements
+  }) ->
+    SessionID = if is_binary(ProvidedSessionID),
+        ProvidedSessionID /= <<"">> -> ProvidedSessionID;
+        true                        -> jlib:now_to_utc_string(now())
+    end,
     case Actions of
-	[] ->
-	    ActionsEls = [];
-	_ ->
-	    case DefaultAction of
-		"" ->
-		    ActionsElAttrs = [];
-		_ ->
-		    ActionsElAttrs = [{"execute", DefaultAction}]
-	    end,
-	    ActionsEls = [{xmlelement, "actions",
-			   ActionsElAttrs,
-			   [{xmlelement, Action, [], []} || Action <- Actions]}]
+        [] ->
+            ActionsEls = [];
+        _ ->
+            case DefaultAction of
+                <<"">> -> ActionsElAttrs = [];
+                _      -> ActionsElAttrs = [{<<"execute">>, DefaultAction}]
+            end,
+            ActionsEls = [
+                #xmlel{
+                    name = <<"actions">>,
+                    attrs = ActionsElAttrs,
+                    children = [
+                        #xmlel{name = Action, attrs = [], children = []}
+                            || Action <- Actions]
+                }
+            ]
     end,
     NotesEls = lists:map(fun({Type, Text}) ->
-				 {xmlelement, "note",
-				  [{"type", Type}],
-				  [{xmlcdata, Text}]}
-			 end, Notes),
-    {xmlelement, "command",
-     [{"xmlns", ?NS_COMMANDS},
-      {"sessionid", SessionID},
-      {"node", Node},
-      {"status", atom_to_list(Status)}],
-     ActionsEls ++ NotesEls ++ Elements}.
+        #xmlel{
+            name     = <<"note">>,
+            attrs    = [{<<"type">>, Type}],
+            children = [{xmlcdata, Text}]
+        }
+    end, Notes),
+    #xmlel{
+        name     = <<"command">>,
+        attrs    = [
+            {<<"xmlns">>,     ?NS_COMMANDS},
+            {<<"sessionid">>, SessionID},
+            {<<"node">>,      Node},
+            {<<"status">>,    iolist_to_binary(atom_to_list(Status))}
+        ],
+        children = ActionsEls ++ NotesEls ++ Elements
+    }.

src/adhoc.hrl

@@ -1,6 +1,6 @@
 %%%----------------------------------------------------------------------
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -19,18 +19,27 @@
 %%%
 %%%----------------------------------------------------------------------
 
--record(adhoc_request, {lang,
-			node,
-			sessionid,
-			action,
-			xdata,
-			others}).
+-record(adhoc_request,
+{
+    lang = <<"">>      :: binary(),
+    node = <<"">>      :: binary(),
+    sessionid = <<"">> :: binary(),
+    action = <<"">>    :: binary(),
+    xdata = false      :: false | xmlel(),
+    others = []        :: [xmlel()]
+}).
 
--record(adhoc_response, {lang,
-			 node,
-			 sessionid,
-			 status,
-			 defaultaction = "",
-			 actions = [],
-			 notes = [],
-			 elements = []}).
+-record(adhoc_response,
+{
+    lang = <<"">>          :: binary(),
+    node = <<"">>          :: binary(),
+    sessionid = <<"">>     :: binary(),
+    status                 :: atom(),
+    defaultaction = <<"">> :: binary(),
+    actions       = []     :: [binary()],
+    notes         = []     :: [{binary(), binary()}],
+    elements      = []     :: [xmlel()]
+}).
+
+-type adhoc_request() :: #adhoc_request{}.
+-type adhoc_response() :: #adhoc_response{}.

src/beam_util.erl

@@ -0,0 +1,56 @@
+%% Copyright (C) 2009 Romuald du Song <rdusong _AT_ gmail _DOT_ com>.
+%% All rights reserved.
+%%
+%% Redistribution and use in source and binary forms, with or without
+%% modification, are permitted provided that the following conditions
+%% are met: 
+%%
+%% 1. Redistributions of source code must retain the above copyright
+%%    notice, this list of conditions and the following disclaimer. 
+%% 2. Redistributions in binary form must reproduce the above
+%%    copyright notice, this list of conditions and the following
+%%    disclaimer in the documentation and/or other materials provided
+%%    with the distribution.
+%%
+%% THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
+%% OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+%% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+%% DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+%% GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+%% NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+-module(beam_util).
+
+-export([module_export_list/1, filter_arity/3]).
+
+
+%% Module = string()
+%% Function = atom()
+module_export_list( Module ) ->
+	{_Module, _Binary, Filename} = code:get_object_code(Module),
+	case beam_lib:info( Filename ) of
+		{error, beam_lib, _} ->
+			false;
+		[ _ , _ , _ ] ->
+			case beam_lib:chunks( Filename, [exports]) of
+				{ok, {_, [{exports, Exports}]}} ->
+					Exports;
+				{error, beam_lib, Er} ->
+					false
+			end
+	end. 
+
+%% Module = string()
+%% Arity = integer()
+%% Exports = list()
+filter_arity( Function, Arity, Exports) ->
+	case lists:filter(
+		   fun( EFName ) -> {Function, Arity} == EFName end,
+		   Exports ) of
+		[{_, _}] -> true;
+		[] -> false
+	end. 

src/cache_tab.erl

@@ -6,7 +6,7 @@
 %%% Created : 29 Aug 2010 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -380,11 +380,11 @@ do_setopts(#state{procs_num = N} = State, Opts) ->
 		shrink_size = ShrinkSize}.
 
 get_proc_num() ->
-    case erlang:system_info(logical_processors) of
-        unknown ->
-            1;
-        Num ->
-            Num
+    case catch erlang:system_info(logical_processors) of
+        Num when is_integer(Num) ->
+            Num;
+        _ ->
+            1
     end.
 
 get_proc_by_hash(Tab, Term) ->

src/cache_tab_sup.erl

@@ -6,7 +6,7 @@
 %%% Created : 30 Aug 2010 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as

src/configure

@@ -1,6 +1,6 @@
 #! /bin/sh
 # Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.68 for ejabberd 2.1.x.
+# Generated by GNU Autoconf 2.68 for ejabberd 3.0.0.
 #
 # Report bugs to <ejabberd@process-one.net>.
 #
@@ -560,8 +560,8 @@ MAKEFLAGS=
 # Identity of this package.
 PACKAGE_NAME='ejabberd'
 PACKAGE_TARNAME='ejabberd'
-PACKAGE_VERSION='2.1.x'
-PACKAGE_STRING='ejabberd 2.1.x'
+PACKAGE_VERSION='3.0.0'
+PACKAGE_STRING='ejabberd 3.0.0'
 PACKAGE_BUGREPORT='ejabberd@process-one.net'
 PACKAGE_URL=''
 
@@ -624,6 +624,7 @@ nif
 full_xml
 transient_supervisors
 db_type
+flash_hack
 roster_gateway_workaround
 hipe
 PAM_LIBS
@@ -642,6 +643,8 @@ make_odbc
 odbc
 make_eldap
 eldap
+make_mod_pubsub_ng
+mod_pubsub_ng
 make_mod_pubsub
 mod_pubsub
 make_mod_proxy65
@@ -718,6 +721,7 @@ enable_mod_irc
 enable_mod_muc
 enable_mod_proxy65
 enable_mod_pubsub
+enable_mod_pubsub_ng
 enable_eldap
 enable_odbc
 enable_tls
@@ -728,6 +732,7 @@ enable_pam
 with_pam
 enable_hipe
 enable_roster_gateway_workaround
+enable_flash_hack
 enable_mssql
 enable_transient_supervisors
 enable_full_xml
@@ -1288,7 +1293,7 @@ if test "$ac_init_help" = "long"; then
   # Omit some internal or obsolete options to make the list less imposing.
   # This message is too long to be a string in the A/UX 3.1 sh.
   cat <<_ACEOF
-\`configure' configures ejabberd 2.1.x to adapt to many kinds of systems.
+\`configure' configures ejabberd 3.0.0 to adapt to many kinds of systems.
 
 Usage: $0 [OPTION]... [VAR=VALUE]...
 
@@ -1354,7 +1359,7 @@ fi
 
 if test -n "$ac_init_help"; then
   case $ac_init_help in
-     short | recursive ) echo "Configuration of ejabberd 2.1.x:";;
+     short | recursive ) echo "Configuration of ejabberd 3.0.0:";;
    esac
   cat <<\_ACEOF
 
@@ -1366,6 +1371,7 @@ Optional Features:
   --enable-mod_muc        enable mod_muc (default: yes)
   --enable-mod_proxy65    enable mod_proxy65 (default: yes)
   --enable-mod_pubsub     enable mod_pubsub (default: yes)
+  --enable-mod_pubsub_ng  enable mod_pubsub_ng (default: yes)
   --enable-eldap          enable eldap (default: yes)
   --enable-odbc           enable odbc (default: no)
   --enable-tls            enable tls (default: yes)
@@ -1377,6 +1383,7 @@ Optional Features:
   --enable-roster-gateway-workaround
                           turn on workaround for processing gateway
                           subscriptions (default: no)
+  --enable-flash-hack     support Adobe Flash client XML (default: no)
   --enable-mssql          use Microsoft SQL Server database (default: no,
                           requires --enable-odbc)
   --enable-transient_supervisors
@@ -1479,7 +1486,7 @@ fi
 test -n "$ac_init_help" && exit $ac_status
 if $ac_init_version; then
   cat <<\_ACEOF
-ejabberd configure 2.1.x
+ejabberd configure 3.0.0
 generated by GNU Autoconf 2.68
 
 Copyright (C) 2010 Free Software Foundation, Inc.
@@ -1823,7 +1830,7 @@ cat >config.log <<_ACEOF
 This file contains any messages produced by compilers while
 running configure, to aid debugging if configure makes a mistake.
 
-It was created by ejabberd $as_me 2.1.x, which was
+It was created by ejabberd $as_me 3.0.0, which was
 generated by GNU Autoconf 2.68.  Invocation command line was
 
   $ $0 $@
@@ -4305,6 +4312,28 @@ $as_echo "$mr_enable_mod_pubsub" >&6; }
 
 
 
+mod_pubsub_ng=
+make_mod_pubsub_ng=
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build mod_pubsub_ng" >&5
+$as_echo_n "checking whether build mod_pubsub_ng... " >&6; }
+# Check whether --enable-mod_pubsub_ng was given.
+if test "${enable_mod_pubsub_ng+set}" = set; then :
+  enableval=$enable_mod_pubsub_ng; mr_enable_mod_pubsub_ng="$enableval"
+else
+  mr_enable_mod_pubsub_ng=yes
+fi
+
+if test "$mr_enable_mod_pubsub_ng" = "yes"; then
+mod_pubsub_ng=mod_pubsub_ng
+make_mod_pubsub_ng=mod_pubsub_ng/Makefile
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $mr_enable_mod_pubsub_ng" >&5
+$as_echo "$mr_enable_mod_pubsub_ng" >&6; }
+
+
+
+
+
 eldap=
 make_eldap=
 { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build eldap" >&5
@@ -4644,6 +4673,19 @@ fi
 
 
 
+# Check whether --enable-flash_hack was given.
+if test "${enable_flash_hack+set}" = set; then :
+  enableval=$enable_flash_hack; case "${enableval}" in
+  yes) flash_hack=true ;;
+  no)  flash_hack=false ;;
+  *) as_fn_error $? "bad value ${enableval} for --enable-flash-hack" "$LINENO" 5 ;;
+esac
+else
+  flash_hack=false
+fi
+
+
+
 # Check whether --enable-mssql was given.
 if test "${enable_mssql+set}" = set; then :
   enableval=$enable_mssql; case "${enableval}" in
@@ -4696,7 +4738,7 @@ fi
 
 
 
-ac_config_files="$ac_config_files Makefile $make_mod_irc $make_mod_muc $make_mod_pubsub $make_mod_proxy65 $make_eldap $make_pam $make_web stringprep/Makefile stun/Makefile $make_tls $make_odbc $make_ejabberd_zlib"
+ac_config_files="$ac_config_files Makefile $make_mod_irc $make_mod_muc $make_mod_pubsub $make_mod_pubsub_ng $make_mod_proxy65 $make_eldap $make_pam $make_web stringprep/Makefile stun/Makefile $make_tls $make_odbc $make_ejabberd_zlib"
 
 #openssl
 
@@ -5690,7 +5732,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
 # report actual input values of CONFIG_FILES etc. instead of their
 # values after options handling.
 ac_log="
-This file was extended by ejabberd $as_me 2.1.x, which was
+This file was extended by ejabberd $as_me 3.0.0, which was
 generated by GNU Autoconf 2.68.  Invocation command line was
 
   CONFIG_FILES    = $CONFIG_FILES
@@ -5743,7 +5785,7 @@ _ACEOF
 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
 ac_cs_version="\\
-ejabberd config.status 2.1.x
+ejabberd config.status 3.0.0
 configured by $0, generated by GNU Autoconf 2.68,
   with options \\"\$ac_cs_config\\"
 
@@ -5857,6 +5899,7 @@ do
     "$make_mod_irc") CONFIG_FILES="$CONFIG_FILES $make_mod_irc" ;;
     "$make_mod_muc") CONFIG_FILES="$CONFIG_FILES $make_mod_muc" ;;
     "$make_mod_pubsub") CONFIG_FILES="$CONFIG_FILES $make_mod_pubsub" ;;
+    "$make_mod_pubsub_ng") CONFIG_FILES="$CONFIG_FILES $make_mod_pubsub_ng" ;;
     "$make_mod_proxy65") CONFIG_FILES="$CONFIG_FILES $make_mod_proxy65" ;;
     "$make_eldap") CONFIG_FILES="$CONFIG_FILES $make_eldap" ;;
     "$make_pam") CONFIG_FILES="$CONFIG_FILES $make_pam" ;;

src/configure.ac

@@ -36,6 +36,7 @@ AC_MOD_ENABLE(mod_irc, yes)
 AC_MOD_ENABLE(mod_muc, yes)
 AC_MOD_ENABLE(mod_proxy65, yes)
 AC_MOD_ENABLE(mod_pubsub, yes)
+AC_MOD_ENABLE(mod_pubsub_ng, yes)
 AC_MOD_ENABLE(eldap, yes)
 AC_MOD_ENABLE(odbc, no)
 AC_MOD_ENABLE(tls, yes)
@@ -67,6 +68,15 @@ AC_ARG_ENABLE(roster_gateway_workaround,
 esac],[roster_gateway_workaround=false])
 AC_SUBST(roster_gateway_workaround)
 
+AC_ARG_ENABLE(flash_hack,
+[AC_HELP_STRING([--enable-flash-hack], [support Adobe Flash client XML (default: no)])],
+[case "${enableval}" in
+  yes) flash_hack=true ;;
+  no)  flash_hack=false ;;
+  *) AC_MSG_ERROR(bad value ${enableval} for --enable-flash-hack) ;;
+esac],[flash_hack=false])
+AC_SUBST(flash_hack)
+
 AC_ARG_ENABLE(mssql,
 [AC_HELP_STRING([--enable-mssql], [use Microsoft SQL Server database (default: no, requires --enable-odbc)])],
 [case "${enableval}" in
@@ -107,6 +117,7 @@ AC_CONFIG_FILES([Makefile
                  $make_mod_irc
                  $make_mod_muc
                  $make_mod_pubsub
+                 $make_mod_pubsub_ng
                  $make_mod_proxy65
                  $make_eldap
                  $make_pam

src/configure.erl

@@ -5,7 +5,7 @@
 %%% Created : 27 Jan 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -62,7 +62,7 @@ start() ->
     RootDirS = "ERLANG_DIR = " ++ code:root_dir() ++ "\n",
     %% Load the ejabberd application description so that ?VERSION can read the vsn key
     application:load(ejabberd),
-    Version  = "EJABBERD_VERSION = " ++ ?VERSION ++ "\n",
+    Version  = "EJABBERD_VERSION = " ++ binary_to_list(?VERSION) ++ "\n",
     ExpatDir = "EXPAT_DIR = c:\\sdk\\Expat-2.0.0\n",
     OpenSSLDir = "OPENSSL_DIR = c:\\sdk\\OpenSSL\n",
     DBType = "DBTYPE = generic\n",    %% 'generic' or 'mssql'

src/cyrsasl.erl

@@ -5,7 +5,7 @@
 %%% Created :  8 Mar 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,43 +25,76 @@
 %%%----------------------------------------------------------------------
 
 -module(cyrsasl).
+
 -author('alexey@process-one.net').
 
--export([start/0,
-	 register_mechanism/3,
-	 listmech/1,
-	 server_new/7,
-	 server_start/3,
-	 server_step/2]).
+-export([start/0, register_mechanism/3, listmech/1,
+	 server_new/7, server_start/3, server_step/2]).
 
 -include("ejabberd.hrl").
 
--record(sasl_mechanism, {mechanism, module, password_type}).
--record(sasl_state, {service, myname, realm,
-		     get_password, check_password, check_password_digest,
-		     mech_mod, mech_state}).
+%%
+-export_type([
+    mechanism/0,
+    mechanisms/0,
+    sasl_mechanism/0
+]).
 
--export([behaviour_info/1]).
+-record(sasl_mechanism,
+        {mechanism = <<"">>    :: mechanism() | '$1',
+         module                :: atom(),
+         password_type = plain :: password_type() | '$2'}).
 
-behaviour_info(callbacks) ->
-    [{mech_new, 4}, {mech_step, 2}];
-behaviour_info(_Other) ->
-    undefined.
+-type(mechanism() :: binary()).
+-type(mechanisms() :: [mechanism(),...]).
+-type(password_type() :: plain | digest | scram).
+-type(props() :: [{username, binary()} |
+                  {authzid, binary()} |
+                  {auth_module, atom()}]).
+
+-type(sasl_mechanism() :: #sasl_mechanism{}).
+
+-record(sasl_state,
+{
+    service,
+    myname,
+    realm,
+    get_password,
+    check_password,
+    check_password_digest,
+    mech_mod,
+    mech_state
+}).
+
+-callback mech_new(binary(), fun(), fun(), fun()) -> any().
+-callback mech_step(any(), binary()) -> {ok, props()} |
+                                        {ok, props(), binary()} |
+                                        {continue, binary(), any()} |
+                                        {error, binary()} |
+                                        {error, binary(), binary()}.
 
 start() ->
-    ets:new(sasl_mechanism, [named_table,
-			     public,
-			     {keypos, #sasl_mechanism.mechanism}]),
+    ets:new(sasl_mechanism,
+	    [named_table, public,
+	     {keypos, #sasl_mechanism.mechanism}]),
     cyrsasl_plain:start([]),
     cyrsasl_digest:start([]),
     cyrsasl_scram:start([]),
     cyrsasl_anonymous:start([]),
     ok.
 
+%%
+-spec(register_mechanism/3 ::
+(
+  Mechanim     :: mechanism(),
+  Module       :: module(),
+  PasswordType :: password_type())
+    -> any()
+).
+
 register_mechanism(Mechanism, Module, PasswordType) ->
     ets:insert(sasl_mechanism,
-	       #sasl_mechanism{mechanism = Mechanism,
-			       module = Module,
+	       #sasl_mechanism{mechanism = Mechanism, module = Module,
 			       password_type = PasswordType}).
 
 %%% TODO: use callbacks
@@ -89,95 +122,94 @@ register_mechanism(Mechanism, Module, PasswordType) ->
 %%    end.
 
 check_credentials(_State, Props) ->
-    User = xml:get_attr_s(username, Props),
+    User = proplists:get_value(username, Props, <<>>),
     case jlib:nodeprep(User) of
-	error ->
-	    {error, "not-authorized"};
-	"" ->
-	    {error, "not-authorized"};
-	_LUser ->
-	    ok
+      error -> {error, <<"not-authorized">>};
+      <<"">> -> {error, <<"not-authorized">>};
+      _LUser -> ok
     end.
 
+-spec(listmech/1 ::
+(
+  Host ::binary())
+    -> Mechanisms::mechanisms()
+).
+
 listmech(Host) ->
     Mechs = ets:select(sasl_mechanism,
 		       [{#sasl_mechanism{mechanism = '$1',
-					 password_type = '$2',
-					 _ = '_'},
+					 password_type = '$2', _ = '_'},
 			 case catch ejabberd_auth:store_type(Host) of
-			 external ->
-			      [{'==', '$2', plain}];
-			 scram ->
-			      [{'/=', '$2', digest}];
-			 {'EXIT',{undef,[{Module,store_type,[]} | _]}} ->
-			      ?WARNING_MSG("~p doesn't implement the function store_type/0", [Module]),
-			      [];
-			 _Else ->
-			      []
+			   external -> [{'==', '$2', plain}];
+			   scram -> [{'/=', '$2', digest}];
+			   {'EXIT', {undef, [{Module, store_type, []} | _]}} ->
+			       ?WARNING_MSG("~p doesn't implement the function store_type/0",
+					    [Module]),
+			       [];
+			   _Else -> []
 			 end,
 			 ['$1']}]),
     filter_anonymous(Host, Mechs).
 
 server_new(Service, ServerFQDN, UserRealm, _SecFlags,
 	   GetPassword, CheckPassword, CheckPasswordDigest) ->
-    #sasl_state{service = Service,
-		myname = ServerFQDN,
-		realm = UserRealm,
-		get_password = GetPassword,
+    #sasl_state{service = Service, myname = ServerFQDN,
+		realm = UserRealm, get_password = GetPassword,
 		check_password = CheckPassword,
-		check_password_digest= CheckPasswordDigest}.
+		check_password_digest = CheckPasswordDigest}.
 
 server_start(State, Mech, ClientIn) ->
-    case lists:member(Mech, listmech(State#sasl_state.myname)) of
-	true ->
-	    case ets:lookup(sasl_mechanism, Mech) of
-		[#sasl_mechanism{module = Module}] ->
-		    {ok, MechState} = Module:mech_new(
-					State#sasl_state.myname,
-					State#sasl_state.get_password,
-					State#sasl_state.check_password,
-					State#sasl_state.check_password_digest),
-		    server_step(State#sasl_state{mech_mod = Module,
-						 mech_state = MechState},
-				ClientIn);
-		_ ->
-		    {error, "no-mechanism"}
-	    end;
-	false ->
-	    {error, "no-mechanism"}
+    case lists:member(Mech,
+		      listmech(State#sasl_state.myname))
+	of
+      true ->
+	  case ets:lookup(sasl_mechanism, Mech) of
+	    [#sasl_mechanism{module = Module}] ->
+		{ok, MechState} =
+		    Module:mech_new(State#sasl_state.myname,
+				    State#sasl_state.get_password,
+				    State#sasl_state.check_password,
+				    State#sasl_state.check_password_digest),
+		server_step(State#sasl_state{mech_mod = Module,
+					     mech_state = MechState},
+			    ClientIn);
+	    _ -> {error, <<"no-mechanism">>}
+	  end;
+      false -> {error, <<"no-mechanism">>}
     end.
 
 server_step(State, ClientIn) ->
     Module = State#sasl_state.mech_mod,
     MechState = State#sasl_state.mech_state,
     case Module:mech_step(MechState, ClientIn) of
-	{ok, Props} ->
-	    case check_credentials(State, Props) of
-		ok ->
-		    {ok, Props};
-		{error, Error} ->
-		    {error, Error}
-	    end;
-	{ok, Props, ServerOut} ->
-	    case check_credentials(State, Props) of
-		ok ->
-		    {ok, Props, ServerOut};
-		{error, Error} ->
-		    {error, Error}
-	    end;
-	{continue, ServerOut, NewMechState} ->
-	    {continue, ServerOut,
-	     State#sasl_state{mech_state = NewMechState}};
-	{error, Error, Username} ->
-	    {error, Error, Username};
-	{error, Error} ->
-	    {error, Error}
+        {ok, Props} ->
+            case check_credentials(State, Props) of
+                ok             -> {ok, Props};
+                {error, Error} -> {error, Error}
+            end;
+        {ok, Props, ServerOut} ->
+            case check_credentials(State, Props) of
+                ok             -> {ok, Props, ServerOut};
+                {error, Error} -> {error, Error}
+            end;
+        {continue, ServerOut, NewMechState} ->
+            {continue, ServerOut, State#sasl_state{mech_state = NewMechState}};
+        {error, Error, Username} ->
+            {error, Error, Username};
+        {error, Error} ->
+            {error, Error}
     end.
 
-%% Remove the anonymous mechanism from the list if not enabled for the given
-%% host
+%%
+-spec(filter_anonymous/2 ::
+(
+  Host  :: binary(),
+  Mechs :: mechanisms())
+    -> mechanisms()
+).
+
 filter_anonymous(Host, Mechs) ->
     case ejabberd_auth_anonymous:is_sasl_anonymous_enabled(Host) of
-	true  -> Mechs;
-	false -> Mechs -- ["ANONYMOUS"]
+      true  -> Mechs;
+      false -> Mechs -- [<<"ANONYMOUS">>]
     end.

src/cyrsasl_anonymous.erl

@@ -6,7 +6,7 @@
 %%% Created : 23 Aug 2005 by Magnus Henoch <henoch@dtek.chalmers.se>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -31,26 +31,20 @@
 
 -behaviour(cyrsasl).
 
--record(state, {server}).
+-record(state, {server = <<"">> :: binary()}).
 
 start(_Opts) ->
-    cyrsasl:register_mechanism("ANONYMOUS", ?MODULE, plain),
+    cyrsasl:register_mechanism(<<"ANONYMOUS">>, ?MODULE, plain),
     ok.
 
-stop() ->
-    ok.
+stop() -> ok.
 
 mech_new(Host, _GetPassword, _CheckPassword, _CheckPasswordDigest) ->
     {ok, #state{server = Host}}.
 
-mech_step(State, _ClientIn) ->
-    %% We generate a random username:
-    User = lists:concat([randoms:get_string() | tuple_to_list(now())]),
-    Server = State#state.server,
-    
-    %% Checks that the username is available
+mech_step(#state{server = Server}, _ClientIn) ->
+    User = randoms:get_string(),
     case ejabberd_auth:is_user_exists(User, Server) of
-	true  -> {error, "not-authorized"};
-	false -> {ok, [{username, User},
-		       {auth_module, ejabberd_auth_anonymous}]}
+        true  -> {error, <<"not-authorized">>};
+        false -> {ok, [{username, User}, {auth_module, ejabberd_auth_anonymous}]}
     end.

src/cyrsasl_digest.erl

@@ -5,7 +5,7 @@
 %%% Created : 11 Mar 2003 by Alexey Shchepin <alexey@sevcom.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,211 +25,228 @@
 %%%----------------------------------------------------------------------
 
 -module(cyrsasl_digest).
+
 -author('alexey@sevcom.net').
 
--export([start/1,
-	 stop/0,
-	 mech_new/4,
-	 mech_step/2]).
+-export([start/1, stop/0, mech_new/4, mech_step/2, parse/1]).
 
 -include("ejabberd.hrl").
 
 -behaviour(cyrsasl).
 
--record(state, {step, nonce, username, authzid, get_password, check_password, auth_module,
-		host, hostfqdn}).
+-type get_password_fun() :: fun((binary()) -> {false, any()} |
+                                              {binary(), atom()}).
+
+-type check_password_fun() :: fun((binary(), binary(), binary(),
+                                   fun((binary()) -> binary())) ->
+                                           {boolean(), any()} |
+                                           false).
+
+-record(state, {step = 1 :: 1 | 3 | 5,
+                nonce = <<"">> :: binary(),
+                username = <<"">> :: binary(),
+                authzid = <<"">> :: binary(),
+                get_password = fun(_) -> {false, <<>>} end :: get_password_fun(),
+                check_password = fun(_, _, _, _) -> false end :: check_password_fun(),
+                auth_module :: atom(),
+                host = <<"">> :: binary(),
+                hostfqdn :: binary() | [binary()]}).
+
 
 start(_Opts) ->
     Fqdn = get_local_fqdn(),
-    ?INFO_MSG("FQDN used to check DIGEST-MD5 SASL authentication: ~p", [Fqdn]),
-    cyrsasl:register_mechanism("DIGEST-MD5", ?MODULE, digest).
+    ?INFO_MSG("FQDN used to check DIGEST-MD5 SASL authentication: ~s",
+	      [Fqdn]),
+    cyrsasl:register_mechanism(<<"DIGEST-MD5">>, ?MODULE,
+			       digest).
 
-stop() ->
-    ok.
+stop() -> ok.
 
-mech_new(Host, GetPassword, _CheckPassword, CheckPasswordDigest) ->
-    {ok, #state{step = 1,
-		nonce = randoms:get_string(),
-		host = Host,
-		hostfqdn = get_local_fqdn(),
-		get_password = GetPassword,
-		check_password = CheckPasswordDigest}}.
+mech_new(Host, GetPassword, _CheckPassword,
+	 CheckPasswordDigest) ->
+    {ok,
+     #state{step = 1, nonce = randoms:get_string(),
+	    host = Host, hostfqdn = get_local_fqdn(),
+	    get_password = GetPassword,
+	    check_password = CheckPasswordDigest}}.
 
 mech_step(#state{step = 1, nonce = Nonce} = State, _) ->
     {continue,
-     "nonce=\"" ++ Nonce ++
-     "\",qop=\"auth\",charset=utf-8,algorithm=md5-sess",
+     <<"nonce=\"", Nonce/binary,
+       "\",qop=\"auth\",charset=utf-8,algorithm=md5-sess">>,
      State#state{step = 3}};
-mech_step(#state{step = 3, nonce = Nonce} = State, ClientIn) ->
+mech_step(#state{step = 3, nonce = Nonce} = State,
+	  ClientIn) ->
     case parse(ClientIn) of
-	bad ->
-	    {error, "bad-protocol"};
-	KeyVals ->
-	    DigestURI = xml:get_attr_s("digest-uri", KeyVals),
-	    UserName = xml:get_attr_s("username", KeyVals),
-	    case is_digesturi_valid(DigestURI, State#state.host, State#state.hostfqdn) of
-		false ->
-		    ?DEBUG("User login not authorized because digest-uri "
-			   "seems invalid: ~p (checking for Host ~p, FQDN ~p)", [DigestURI,
-			   State#state.host, State#state.hostfqdn]),
-		    {error, "not-authorized", UserName};
-		true ->
-		    AuthzId = xml:get_attr_s("authzid", KeyVals),
-		    case (State#state.get_password)(UserName) of
-			{false, _} ->
-			    {error, "not-authorized", UserName};
-			{Passwd, AuthModule} ->
-				case (State#state.check_password)(UserName, "",
-					xml:get_attr_s("response", KeyVals),
-					fun(PW) -> response(KeyVals, UserName, PW, Nonce, AuthzId,
-						"AUTHENTICATE") end) of
-				{true, _} ->
-				    RspAuth = response(KeyVals,
-						       UserName, Passwd,
-						       Nonce, AuthzId, ""),
-				    {continue,
-				     "rspauth=" ++ RspAuth,
-				     State#state{step = 5,
-						 auth_module = AuthModule,
-						 username = UserName,
-						 authzid = AuthzId}};
-				false ->
-				    {error, "not-authorized", UserName};
-				{false, _} ->
-				    {error, "not-authorized", UserName}
-			    end
-		    end
-	    end
+      bad -> {error, <<"bad-protocol">>};
+      KeyVals ->
+	  DigestURI = proplists:get_value(<<"digest-uri">>, KeyVals, <<>>),
+	  %DigestURI = xml:get_attr_s(<<"digest-uri">>, KeyVals),
+	  UserName = proplists:get_value(<<"username">>, KeyVals, <<>>),
+	  %UserName = xml:get_attr_s(<<"username">>, KeyVals),
+	  case is_digesturi_valid(DigestURI, State#state.host,
+				  State#state.hostfqdn)
+	      of
+	    false ->
+		?DEBUG("User login not authorized because digest-uri "
+		       "seems invalid: ~p (checking for Host "
+		       "~p, FQDN ~p)",
+		       [DigestURI, State#state.host, State#state.hostfqdn]),
+		{error, <<"not-authorized">>, UserName};
+	    true ->
+		AuthzId = proplists:get_value(<<"authzid">>, KeyVals, <<>>),
+		%AuthzId = xml:get_attr_s(<<"authzid">>, KeyVals),
+		case (State#state.get_password)(UserName) of
+		  {false, _} -> {error, <<"not-authorized">>, UserName};
+		  {Passwd, AuthModule} ->
+		      case (State#state.check_password)(UserName, <<"">>,
+		                    proplists:get_value(<<"response">>, KeyVals, <<>>),
+							%xml:get_attr_s(<<"response">>, KeyVals),
+							fun (PW) ->
+								response(KeyVals,
+									 UserName,
+									 PW,
+									 Nonce,
+									 AuthzId,
+									 <<"AUTHENTICATE">>)
+							end)
+			  of
+			{true, _} ->
+			    RspAuth = response(KeyVals, UserName, Passwd, Nonce,
+					       AuthzId, <<"">>),
+			    {continue, <<"rspauth=", RspAuth/binary>>,
+			     State#state{step = 5, auth_module = AuthModule,
+					 username = UserName,
+					 authzid = AuthzId}};
+			false -> {error, <<"not-authorized">>, UserName};
+			{false, _} -> {error, <<"not-authorized">>, UserName}
+		      end
+		end
+	  end
     end;
-mech_step(#state{step = 5,
-		 auth_module = AuthModule,
-		 username = UserName,
-		 authzid = AuthzId}, "") ->
-    {ok, [{username, UserName}, {authzid, AuthzId},
-	  {auth_module, AuthModule}]};
+mech_step(#state{step = 5, auth_module = AuthModule,
+		 username = UserName, authzid = AuthzId},
+	  <<"">>) ->
+    {ok,
+     [{username, UserName}, {authzid, AuthzId},
+      {auth_module, AuthModule}]};
 mech_step(A, B) ->
-    ?DEBUG("SASL DIGEST: A ~p B ~p", [A,B]),
-    {error, "bad-protocol"}.
+    ?DEBUG("SASL DIGEST: A ~p B ~p", [A, B]),
+    {error, <<"bad-protocol">>}.
 
-parse(S) ->
-    parse1(S, "", []).
+parse(S) -> parse1(binary_to_list(S), "", []).
 
 parse1([$= | Cs], S, Ts) ->
     parse2(Cs, lists:reverse(S), "", Ts);
-parse1([$, | Cs], [], Ts) ->
-    parse1(Cs, [], Ts);
-parse1([$\s | Cs], [], Ts) ->
-    parse1(Cs, [], Ts);
-parse1([C | Cs], S, Ts) ->
-    parse1(Cs, [C | S], Ts);
-parse1([], [], T) ->
-    lists:reverse(T);
-parse1([], _S, _T) ->
-    bad.
+parse1([$, | Cs], [], Ts) -> parse1(Cs, [], Ts);
+parse1([$\s | Cs], [], Ts) -> parse1(Cs, [], Ts);
+parse1([C | Cs], S, Ts) -> parse1(Cs, [C | S], Ts);
+parse1([], [], T) -> lists:reverse(T);
+parse1([], _S, _T) -> bad.
 
-parse2([$\" | Cs], Key, Val, Ts) ->
+parse2([$" | Cs], Key, Val, Ts) ->
     parse3(Cs, Key, Val, Ts);
 parse2([C | Cs], Key, Val, Ts) ->
     parse4(Cs, Key, [C | Val], Ts);
-parse2([], _, _, _) ->
-    bad.
+parse2([], _, _, _) -> bad.
 
-parse3([$\" | Cs], Key, Val, Ts) ->
+parse3([$" | Cs], Key, Val, Ts) ->
     parse4(Cs, Key, Val, Ts);
 parse3([$\\, C | Cs], Key, Val, Ts) ->
     parse3(Cs, Key, [C | Val], Ts);
 parse3([C | Cs], Key, Val, Ts) ->
     parse3(Cs, Key, [C | Val], Ts);
-parse3([], _, _, _) ->
-    bad.
+parse3([], _, _, _) -> bad.
 
 parse4([$, | Cs], Key, Val, Ts) ->
-    parse1(Cs, "", [{Key, lists:reverse(Val)} | Ts]);
+    parse1(Cs, "", [{list_to_binary(Key), list_to_binary(lists:reverse(Val))} | Ts]);
 parse4([$\s | Cs], Key, Val, Ts) ->
     parse4(Cs, Key, Val, Ts);
 parse4([C | Cs], Key, Val, Ts) ->
     parse4(Cs, Key, [C | Val], Ts);
 parse4([], Key, Val, Ts) ->
-    parse1([], "", [{Key, lists:reverse(Val)} | Ts]).
+    parse1([], "", [{list_to_binary(Key), list_to_binary(lists:reverse(Val))} | Ts]).
 
-
-%% @doc Check if the digest-uri is valid.
-%% RFC-2831 allows to provide the IP address in Host,
-%% however ejabberd doesn't allow that.
-%% If the service (for example jabber.example.org)
-%% is provided by several hosts (being one of them server3.example.org),
-%% then acceptable digest-uris would be:
-%% xmpp/server3.example.org/jabber.example.org, xmpp/server3.example.org and
-%% xmpp/jabber.example.org
-%% The last version is not actually allowed by the RFC, but implemented by popular clients
-is_digesturi_valid(DigestURICase, JabberDomain, JabberFQDN) ->
+is_digesturi_valid(DigestURICase, JabberDomain,
+		   JabberFQDN) ->
     DigestURI = stringprep:tolower(DigestURICase),
-    case catch string:tokens(DigestURI, "/") of
-	["xmpp", Host] when (Host == JabberDomain) or (Host == JabberFQDN) ->
-	    true;
-	["xmpp", Host, ServName] when (ServName == JabberDomain) and (Host == JabberFQDN) ->
-	    true;
+    case catch str:tokens(DigestURI, <<"/">>) of
+	[<<"xmpp">>, Host] ->
+	    IsHostFqdn = is_host_fqdn(Host, JabberFQDN),
+	    (Host == JabberDomain) or IsHostFqdn;
+	[<<"xmpp">>, Host, ServName] ->
+	    IsHostFqdn = is_host_fqdn(Host, JabberFQDN),
+	    (ServName == JabberDomain) and IsHostFqdn;
 	_ ->
 	    false
     end.
 
+is_host_fqdn(Host, Fqdn) when Host == Fqdn ->
+    true;
+is_host_fqdn(_Host, <<"">>) ->
+    false;
+is_host_fqdn(Host, [Fqdn | _FqdnTail]) when Host == Fqdn ->
+    true;
+is_host_fqdn(Host, [Fqdn | FqdnTail]) when Host /= Fqdn ->
+    is_host_fqdn(Host, FqdnTail);
+is_host_fqdn(_Host, _Fqdn) ->
+    false.
+
 get_local_fqdn() ->
-    case (catch get_local_fqdn2()) of
-	Str when is_list(Str) -> Str;
-	_ -> "unknown-fqdn, please configure fqdn option in ejabberd.cfg!"
-    end.
-get_local_fqdn2() ->
-    case ejabberd_config:get_local_option(fqdn) of
-	ConfiguredFqdn when is_list(ConfiguredFqdn) ->
-	    ConfiguredFqdn;
-	_undefined ->
-	    {ok, Hostname} = inet:gethostname(),
-	    {ok, {hostent, Fqdn, _, _, _, _}} = inet:gethostbyname(Hostname),
-	    Fqdn
+    case catch get_local_fqdn2() of
+      Str when is_binary(Str) -> Str;
+      _ ->
+	  <<"unknown-fqdn, please configure fqdn "
+	    "option in ejabberd.cfg!">>
     end.
 
-digit_to_xchar(D) when (D >= 0) and (D < 10) ->
-    D + 48;
-digit_to_xchar(D) ->
-    D + 87.
+get_local_fqdn2() ->
+    case ejabberd_config:get_local_option(
+           fqdn, fun iolist_to_binary/1) of
+        ConfiguredFqdn when is_binary(ConfiguredFqdn) ->
+            ConfiguredFqdn;
+        undefined ->
+            {ok, Hostname} = inet:gethostname(),
+            {ok, {hostent, Fqdn, _, _, _, _}} =
+            inet:gethostbyname(Hostname),
+            list_to_binary(Fqdn)
+    end.
 
 hex(S) ->
-    hex(S, []).
+    sha:to_hexlist(S).
 
-hex([], Res) ->
-    lists:reverse(Res);
-hex([N | Ns], Res) ->
-    hex(Ns, [digit_to_xchar(N rem 16),
-	     digit_to_xchar(N div 16) | Res]).
+proplists_get_bin_value(Key, Pairs, Default) ->
+    case proplists:get_value(Key, Pairs, Default) of
+        L when is_list(L) ->
+            list_to_binary(L);
+        L2 ->
+            L2
+    end.
 
-
-response(KeyVals, User, Passwd, Nonce, AuthzId, A2Prefix) ->
-    Realm = xml:get_attr_s("realm", KeyVals),
-    CNonce = xml:get_attr_s("cnonce", KeyVals),
-    DigestURI = xml:get_attr_s("digest-uri", KeyVals),
-    NC = xml:get_attr_s("nc", KeyVals),
-    QOP = xml:get_attr_s("qop", KeyVals),
+response(KeyVals, User, Passwd, Nonce, AuthzId,
+	 A2Prefix) ->
+    Realm = proplists_get_bin_value(<<"realm">>, KeyVals, <<>>),
+    CNonce = proplists_get_bin_value(<<"cnonce">>, KeyVals, <<>>),
+    DigestURI = proplists_get_bin_value(<<"digest-uri">>, KeyVals, <<>>),
+    NC = proplists_get_bin_value(<<"nc">>, KeyVals, <<>>),
+    QOP = proplists_get_bin_value(<<"qop">>, KeyVals, <<>>),
+    MD5Hash = crypto:md5(<<User/binary, ":", Realm/binary, ":",
+                           Passwd/binary>>),
     A1 = case AuthzId of
-	     "" ->
-		 binary_to_list(
-		   crypto:md5(User ++ ":" ++ Realm ++ ":" ++ Passwd)) ++
-		     ":" ++ Nonce ++ ":" ++ CNonce;
-	     _ ->
-		 binary_to_list(
-		   crypto:md5(User ++ ":" ++ Realm ++ ":" ++ Passwd)) ++
-		     ":" ++ Nonce ++ ":" ++ CNonce ++ ":" ++ AuthzId
+	   <<"">> ->
+	       <<MD5Hash/binary, ":", Nonce/binary, ":", CNonce/binary>>;
+	   _ ->
+	       <<MD5Hash/binary, ":", Nonce/binary, ":", CNonce/binary, ":",
+		 AuthzId/binary>>
 	 end,
     A2 = case QOP of
-	     "auth" ->
-		 A2Prefix ++ ":" ++ DigestURI;
-	     _ ->
-		 A2Prefix ++ ":" ++ DigestURI ++
-		     ":00000000000000000000000000000000"
+	   <<"auth">> ->
+	       <<A2Prefix/binary, ":", DigestURI/binary>>;
+	   _ ->
+	       <<A2Prefix/binary, ":", DigestURI/binary,
+		 ":00000000000000000000000000000000">>
 	 end,
-    T = hex(binary_to_list(crypto:md5(A1))) ++ ":" ++ Nonce ++ ":" ++
-	NC ++ ":" ++ CNonce ++ ":" ++ QOP ++ ":" ++
-	hex(binary_to_list(crypto:md5(A2))),
-    hex(binary_to_list(crypto:md5(T))).
-
-
-
+    T = <<(hex((crypto:md5(A1))))/binary, ":", Nonce/binary,
+	  ":", NC/binary, ":", CNonce/binary, ":", QOP/binary,
+	  ":", (hex((crypto:md5(A2))))/binary>>,
+    hex((crypto:md5(T))).

src/cyrsasl_plain.erl

@@ -5,7 +5,7 @@
 %%% Created :  8 Mar 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,6 +25,7 @@
 %%%----------------------------------------------------------------------
 
 -module(cyrsasl_plain).
+
 -author('alexey@process-one.net').
 
 -export([start/1, stop/0, mech_new/4, mech_step/2, parse/1]).
@@ -34,67 +35,56 @@
 -record(state, {check_password}).
 
 start(_Opts) ->
-    cyrsasl:register_mechanism("PLAIN", ?MODULE, plain),
+    cyrsasl:register_mechanism(<<"PLAIN">>, ?MODULE, plain),
     ok.
 
-stop() ->
-    ok.
+stop() -> ok.
 
 mech_new(_Host, _GetPassword, CheckPassword, _CheckPasswordDigest) ->
     {ok, #state{check_password = CheckPassword}}.
 
 mech_step(State, ClientIn) ->
     case prepare(ClientIn) of
-	[AuthzId, User, Password] ->
-	    case (State#state.check_password)(User, Password) of
-		{true, AuthModule} ->
-		    {ok, [{username, User}, {authzid, AuthzId},
-			  {auth_module, AuthModule}]};
-		_ ->
-		    {error, "not-authorized", User}
-	    end;
-	_ ->
-	    {error, "bad-protocol"}
+      [AuthzId, User, Password] ->
+	  case (State#state.check_password)(User, Password) of
+	    {true, AuthModule} ->
+		{ok,
+		 [{username, User}, {authzid, AuthzId},
+		  {auth_module, AuthModule}]};
+	    _ -> {error, <<"not-authorized">>, User}
+	  end;
+      _ -> {error, <<"bad-protocol">>}
     end.
 
 prepare(ClientIn) ->
     case parse(ClientIn) of
-	[[], UserMaybeDomain, Password] ->
-	    case parse_domain(UserMaybeDomain) of
-		%% <NUL>login@domain<NUL>pwd
-		[User, _Domain] ->
-		    [UserMaybeDomain, User, Password];
-		%% <NUL>login<NUL>pwd
-		[User] ->
-		    ["", User, Password]
-	    end;
-	%% login@domain<NUL>login<NUL>pwd
-	[AuthzId, User, Password] ->
-	    [AuthzId, User, Password];
-	_ ->
-	    error
+      [<<"">>, UserMaybeDomain, Password] ->
+	  case parse_domain(UserMaybeDomain) of
+	    %% <NUL>login@domain<NUL>pwd
+	    [User, _Domain] -> [UserMaybeDomain, User, Password];
+	    %% <NUL>login<NUL>pwd
+	    [User] -> [<<"">>, User, Password]
+	  end;
+      %% login@domain<NUL>login<NUL>pwd
+      [AuthzId, User, Password] -> [AuthzId, User, Password];
+      _ -> error
     end.
 
-
-parse(S) ->
-    parse1(S, "", []).
+parse(S) -> parse1(binary_to_list(S), "", []).
 
 parse1([0 | Cs], S, T) ->
-    parse1(Cs, "", [lists:reverse(S) | T]);
-parse1([C | Cs], S, T) ->
-    parse1(Cs, [C | S], T);
+    parse1(Cs, "", [list_to_binary(lists:reverse(S)) | T]);
+parse1([C | Cs], S, T) -> parse1(Cs, [C | S], T);
 %parse1([], [], T) ->
 %    lists:reverse(T);
 parse1([], S, T) ->
-    lists:reverse([lists:reverse(S) | T]).
+    lists:reverse([list_to_binary(lists:reverse(S)) | T]).
 
-
-parse_domain(S) ->
-    parse_domain1(S, "", []).
+parse_domain(S) -> parse_domain1(binary_to_list(S), "", []).
 
 parse_domain1([$@ | Cs], S, T) ->
-    parse_domain1(Cs, "", [lists:reverse(S) | T]);
+    parse_domain1(Cs, "", [list_to_binary(lists:reverse(S)) | T]);
 parse_domain1([C | Cs], S, T) ->
     parse_domain1(Cs, [C | S], T);
 parse_domain1([], S, T) ->
-    lists:reverse([lists:reverse(S) | T]).
+    lists:reverse([list_to_binary(lists:reverse(S)) | T]).

src/cyrsasl_scram.erl

@@ -5,7 +5,7 @@
 %%% Created : 7 Aug 2011 by Stephen Röttger <stephen.roettger@googlemail.com>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,166 +25,185 @@
 %%%----------------------------------------------------------------------
 
 -module(cyrsasl_scram).
+
 -author('stephen.roettger@googlemail.com').
 
--export([start/1,
-	 stop/0,
-	 mech_new/4,
-	 mech_step/2]).
+-export([start/1, stop/0, mech_new/4, mech_step/2]).
 
 -include("ejabberd.hrl").
 
 -behaviour(cyrsasl).
 
--record(state, {step, stored_key, server_key, username, get_password, check_password,
-		auth_message, client_nonce, server_nonce}).
+-record(state,
+	{step = 2              :: 2 | 4,
+         stored_key = <<"">>   :: binary(),
+         server_key = <<"">>   :: binary(),
+         username = <<"">>     :: binary(),
+         get_password          :: fun(),
+	 check_password        :: fun(),
+         auth_message = <<"">> :: binary(),
+         client_nonce = <<"">> :: binary(),
+	 server_nonce = <<"">> :: binary()}).
 
 -define(SALT_LENGTH, 16).
+
 -define(NONCE_LENGTH, 16).
 
 start(_Opts) ->
-    cyrsasl:register_mechanism("SCRAM-SHA-1", ?MODULE, scram).
+    cyrsasl:register_mechanism(<<"SCRAM-SHA-1">>, ?MODULE,
+			       scram).
 
-stop() ->
-    ok.
+stop() -> ok.
 
-mech_new(_Host, GetPassword, _CheckPassword, _CheckPasswordDigest) ->
+mech_new(_Host, GetPassword, _CheckPassword,
+	 _CheckPasswordDigest) ->
     {ok, #state{step = 2, get_password = GetPassword}}.
 
 mech_step(#state{step = 2} = State, ClientIn) ->
-	case string:tokens(ClientIn, ",") of
-	[CBind, UserNameAttribute, ClientNonceAttribute] when (CBind == "y") or (CBind == "n") ->
-		case parse_attribute(UserNameAttribute) of
-                {error, Reason} ->
-			{error, Reason};
-		{_, EscapedUserName} ->
-			case unescape_username(EscapedUserName) of
-			error ->
-				{error, "protocol-error-bad-username"};
-			UserName ->
-				case parse_attribute(ClientNonceAttribute) of
-				{$r, ClientNonce} ->
-					case (State#state.get_password)(UserName) of
-					{false, _} ->
-						{error, "not-authorized", UserName};
-					{Ret, _AuthModule} ->
-						{StoredKey, ServerKey, Salt, IterationCount} = if
-						is_tuple(Ret) ->
-							Ret;
-						true ->
-							TempSalt = crypto:rand_bytes(?SALT_LENGTH),
-							SaltedPassword = scram:salted_password(Ret, TempSalt, ?SCRAM_DEFAULT_ITERATION_COUNT),
-							{scram:stored_key(scram:client_key(SaltedPassword)),
-							 scram:server_key(SaltedPassword), TempSalt, ?SCRAM_DEFAULT_ITERATION_COUNT}
-						end,
-						ClientFirstMessageBare = string:substr(ClientIn, string:str(ClientIn, "n=")),
-						ServerNonce = base64:encode_to_string(crypto:rand_bytes(?NONCE_LENGTH)),
-						ServerFirstMessage = "r=" ++ ClientNonce ++ ServerNonce ++ "," ++
-											"s=" ++ base64:encode_to_string(Salt) ++ "," ++
-											"i=" ++ integer_to_list(IterationCount),
-						{continue,
-						 ServerFirstMessage,
-						 State#state{step = 4, stored_key = StoredKey, server_key = ServerKey,
-									 auth_message = ClientFirstMessageBare ++ "," ++ ServerFirstMessage,
-									 client_nonce = ClientNonce, server_nonce = ServerNonce, username = UserName}}
-					end;
-				_Else ->
-					{error, "not-supported"}
-				end
-			end
-		end;
-	_Else ->
-	    {error, "bad-protocol"}
-	end;
+    case str:tokens(ClientIn, <<",">>) of
+      [CBind, UserNameAttribute, ClientNonceAttribute]
+	  when (CBind == <<"y">>) or (CBind == <<"n">>) ->
+	  case parse_attribute(UserNameAttribute) of
+	    {error, Reason} -> {error, Reason};
+	    {_, EscapedUserName} ->
+		case unescape_username(EscapedUserName) of
+		  error -> {error, <<"protocol-error-bad-username">>};
+		  UserName ->
+		      case parse_attribute(ClientNonceAttribute) of
+			{$r, ClientNonce} ->
+			    case (State#state.get_password)(UserName) of
+			      {false, _} -> {error, <<"not-authorized">>, UserName};
+			      {Ret, _AuthModule} ->
+				  {StoredKey, ServerKey, Salt, IterationCount} =
+				      if is_tuple(Ret) -> Ret;
+					 true ->
+					     TempSalt =
+						 crypto:rand_bytes(?SALT_LENGTH),
+					     SaltedPassword =
+						 scram:salted_password(Ret,
+								       TempSalt,
+								       ?SCRAM_DEFAULT_ITERATION_COUNT),
+					     {scram:stored_key(scram:client_key(SaltedPassword)),
+					      scram:server_key(SaltedPassword),
+					      TempSalt,
+					      ?SCRAM_DEFAULT_ITERATION_COUNT}
+				      end,
+				  ClientFirstMessageBare =
+				      str:substr(ClientIn,
+                                                 str:str(ClientIn, <<"n=">>)),
+				  ServerNonce =
+				      jlib:encode_base64(crypto:rand_bytes(?NONCE_LENGTH)),
+				  ServerFirstMessage =
+                                        iolist_to_binary(
+                                          ["r=",
+                                           ClientNonce,
+                                           ServerNonce,
+                                           ",", "s=",
+                                           jlib:encode_base64(Salt),
+                                           ",", "i=",
+                                           integer_to_list(IterationCount)]),
+				  {continue, ServerFirstMessage,
+				   State#state{step = 4, stored_key = StoredKey,
+					       server_key = ServerKey,
+					       auth_message =
+						   <<ClientFirstMessageBare/binary,
+						     ",", ServerFirstMessage/binary>>,
+					       client_nonce = ClientNonce,
+					       server_nonce = ServerNonce,
+					       username = UserName}}
+			    end;
+			_Else -> {error, <<"not-supported">>}
+		      end
+		end
+	  end;
+      _Else -> {error, <<"bad-protocol">>}
+    end;
 mech_step(#state{step = 4} = State, ClientIn) ->
-	case string:tokens(ClientIn, ",") of
-	[GS2ChannelBindingAttribute, NonceAttribute, ClientProofAttribute] ->
-		case parse_attribute(GS2ChannelBindingAttribute) of
-		{$c, CVal} when (CVal == "biws") or (CVal == "eSws") ->
-		    %% biws is base64 for n,, => channelbinding not supported
-		    %% eSws is base64 for y,, => channelbinding supported by client only
- 			Nonce = State#state.client_nonce ++ State#state.server_nonce,
-			case parse_attribute(NonceAttribute) of
-			{$r, CompareNonce} when CompareNonce == Nonce ->
-				case parse_attribute(ClientProofAttribute) of
-				{$p, ClientProofB64} ->
-					ClientProof = base64:decode(ClientProofB64),
-					AuthMessage = State#state.auth_message ++ "," ++ string:substr(ClientIn, 1, string:str(ClientIn, ",p=")-1),
-					ClientSignature = scram:client_signature(State#state.stored_key, AuthMessage),
-					ClientKey = scram:client_key(ClientProof, ClientSignature),
-					CompareStoredKey = scram:stored_key(ClientKey),
-					if CompareStoredKey == State#state.stored_key ->
-						ServerSignature = scram:server_signature(State#state.server_key, AuthMessage),
-						{ok, [{username, State#state.username}], "v=" ++ base64:encode_to_string(ServerSignature)};
-					true ->
-						{error, "bad-auth"}
-					end;
-				_Else ->
-					{error, "bad-protocol"}
-				end;
-			{$r, _} ->
-				{error, "bad-nonce"};
-			_Else ->
-				{error, "bad-protocol"}
-			end;
-		_Else ->
-	   		{error, "bad-protocol"}
+    case str:tokens(ClientIn, <<",">>) of
+      [GS2ChannelBindingAttribute, NonceAttribute,
+       ClientProofAttribute] ->
+	  case parse_attribute(GS2ChannelBindingAttribute) of
+	    {$c, CVal} when (CVal == <<"biws">>) or (CVal == <<"eSws">>) ->
+		%% biws is base64 for n,, => channelbinding not supported
+		%% eSws is base64 for y,, => channelbinding supported by client only
+		Nonce = <<(State#state.client_nonce)/binary,
+			  (State#state.server_nonce)/binary>>,
+		case parse_attribute(NonceAttribute) of
+		  {$r, CompareNonce} when CompareNonce == Nonce ->
+		      case parse_attribute(ClientProofAttribute) of
+			{$p, ClientProofB64} ->
+			    ClientProof = jlib:decode_base64(ClientProofB64),
+			    AuthMessage =
+                                  iolist_to_binary(
+                                    [State#state.auth_message,
+                                     ",",
+                                     str:substr(ClientIn, 1,
+                                                str:str(ClientIn, <<",p=">>)
+                                                - 1)]),
+			    ClientSignature =
+				scram:client_signature(State#state.stored_key,
+						       AuthMessage),
+			    ClientKey = scram:client_key(ClientProof,
+							 ClientSignature),
+			    CompareStoredKey = scram:stored_key(ClientKey),
+			    if CompareStoredKey == State#state.stored_key ->
+				   ServerSignature =
+				       scram:server_signature(State#state.server_key,
+							      AuthMessage),
+				   {ok, [{username, State#state.username}],
+				    <<"v=",
+				      (jlib:encode_base64(ServerSignature))/binary>>};
+			       true -> {error, <<"bad-auth">>}
+			    end;
+			_Else -> {error, <<"bad-protocol">>}
+		      end;
+		  {$r, _} -> {error, <<"bad-nonce">>};
+		  _Else -> {error, <<"bad-protocol">>}
 		end;
-	_Else ->
-		{error, "bad-protocol"}
-	end.
+	    _Else -> {error, <<"bad-protocol">>}
+	  end;
+      _Else -> {error, <<"bad-protocol">>}
+    end.
 
 parse_attribute(Attribute) ->
-	AttributeLen = string:len(Attribute),
-	if
-	AttributeLen >= 3 ->
-		SecondChar = lists:nth(2, Attribute),
-		case is_alpha(lists:nth(1, Attribute)) of
-			true ->
-				if
-				SecondChar == $= ->
-					String = string:substr(Attribute, 3),
-                                        {lists:nth(1, Attribute), String};
-				true ->
-					{error, "bad-format second char not equal sign"}
-				end;
-			_Else ->
-				{error, "bad-format first char not a letter"}
-		end;
-	true -> 
-		{error, "bad-format attribute too short"}
-	end.
+    AttributeLen = byte_size(Attribute),
+    if AttributeLen >= 3 ->
+           AttributeS = binary_to_list(Attribute),
+	   SecondChar = lists:nth(2, AttributeS),
+	   case is_alpha(lists:nth(1, AttributeS)) of
+	     true ->
+		 if SecondChar == $= ->
+			String = str:substr(Attribute, 3),
+			{lists:nth(1, AttributeS), String};
+		    true -> {error, <<"bad-format second char not equal sign">>}
+		 end;
+	     _Else -> {error, <<"bad-format first char not a letter">>}
+	   end;
+       true -> {error, <<"bad-format attribute too short">>}
+    end.
 
-unescape_username("") ->
-	"";
+unescape_username(<<"">>) -> <<"">>;
 unescape_username(EscapedUsername) ->
-	Pos = string:str(EscapedUsername, "="),
-	if
-	Pos == 0 ->
-		EscapedUsername;
-	true ->
-		Start = string:substr(EscapedUsername, 1, Pos-1),
-		End = string:substr(EscapedUsername, Pos),
-		EndLen = string:len(End),
-		if
-		EndLen < 3 ->
-			error;
-		true ->
-			case string:substr(End, 1, 3) of
-			"=2C" ->
-				Start ++ "," ++ unescape_username(string:substr(End, 4));
-			"=3D" ->
-				Start ++ "=" ++ unescape_username(string:substr(End, 4));
-			_Else ->
-				error
-			end
-		end
-	end.
-
-is_alpha(Char) when Char >= $a, Char =< $z ->
-    true;
-is_alpha(Char) when Char >= $A, Char =< $Z -> 
-    true;
-is_alpha(_) ->
-    false.
+    Pos = str:str(EscapedUsername, <<"=">>),
+    if Pos == 0 -> EscapedUsername;
+       true ->
+	   Start = str:substr(EscapedUsername, 1, Pos - 1),
+	   End = str:substr(EscapedUsername, Pos),
+	   EndLen = byte_size(End),
+	   if EndLen < 3 -> error;
+	      true ->
+		  case str:substr(End, 1, 3) of
+		    <<"=2C">> ->
+			<<Start/binary, ",",
+			  (unescape_username(str:substr(End, 4)))/binary>>;
+		    <<"=3D">> ->
+			<<Start/binary, "=",
+			  (unescape_username(str:substr(End, 4)))/binary>>;
+		    _Else -> error
+		  end
+	   end
+    end.
 
+is_alpha(Char) when Char >= $a, Char =< $z -> true;
+is_alpha(Char) when Char >= $A, Char =< $Z -> true;
+is_alpha(_) -> false.

src/ejabberd.app

@@ -2,7 +2,7 @@
 
 {application, ejabberd,
  [{description, "ejabberd"},
-  {vsn, "2.1.11"},
+  {vsn, "3.0.0"},
   {modules, [acl,
 	     adhoc,
 	     configure,
@@ -38,6 +38,7 @@
 	     ejabberd_rdbms,
 	     ejabberd_receiver,
 	     ejabberd_router,
+	     ejabberd_router_multicast,
 	     ejabberd_s2s,
 	     ejabberd_s2s_in,
 	     ejabberd_s2s_out,
@@ -126,6 +127,7 @@
 		ejabberd_sup,
 		ejabberd_auth,
 		ejabberd_router,
+		ejabberd_router_multicast,
 		ejabberd_sm,
 		ejabberd_s2s,
 		ejabberd_local,

src/ejabberd.cfg.example

@@ -154,6 +154,13 @@
   %%
   %%{{3478, udp}, ejabberd_stun, []},
 
+  %%
+  %% To handle XML-RPC requests that provide admin credentials:
+  %%
+  %%{4560, ejabberd_xmlrpc, [
+  %%			{access_commands, [{admin, all, []}]}
+  %%		       ]},
+
   {5280, ejabberd_http, [
 			 %%{request_handlers,
 			 %% [

src/ejabberd.erl

@@ -5,7 +5,7 @@
 %%% Created : 16 Nov 2002 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as

src/ejabberd.hrl

@@ -1,6 +1,6 @@
 %%%----------------------------------------------------------------------
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -19,46 +19,67 @@
 %%%
 %%%----------------------------------------------------------------------
 
-%% This macro returns a string of the ejabberd version running, e.g. "2.3.4"
-%% If the ejabberd application description isn't loaded, returns atom: undefined
--define(VERSION, element(2, application:get_key(ejabberd,vsn))).
+-define(VERSION, ejabberd_config:get_version()).
 
--define(MYHOSTS, ejabberd_config:get_global_option(hosts)).
--define(MYNAME, hd(ejabberd_config:get_global_option(hosts))).
--define(MYLANG, ejabberd_config:get_global_option(language)).
+-define(MYHOSTS, ejabberd_config:get_myhosts()).
 
--define(MSGS_DIR, "msgs").
--define(CONFIG_PATH, "ejabberd.cfg").
--define(LOG_PATH, "ejabberd.log").
+-define(MYNAME, hd(ejabberd_config:get_myhosts())).
 
--define(EJABBERD_URI, "http://www.process-one.net/en/ejabberd/").
+-define(MYLANG, ejabberd_config:get_mylang()).
+
+-define(MSGS_DIR, <<"msgs">>).
+
+-define(CONFIG_PATH, <<"ejabberd.cfg">>).
+
+-define(LOG_PATH, <<"ejabberd.log">>).
+
+-ifdef(ENABLE_FLASH_HACK).
+
+-define(FLASH_HACK, true).
+
+-else.
+
+-define(FLASH_HACK, false).
+
+-endif.
+
+-define(EJABBERD_URI,
+	<<"http://www.process-one.net/en/ejabberd/">>).
 
 -define(S2STIMEOUT, 600000).
 
 %%-define(DBGFSM, true).
 
--record(scram, {storedkey, serverkey, salt, iterationcount}).
+-record(scram,
+	{storedkey = <<"">>,
+         serverkey = <<"">>,
+         salt = <<"">>,
+         iterationcount = 0 :: integer()}).
+
+-type scram() :: #scram{}.
+
 -define(SCRAM_DEFAULT_ITERATION_COUNT, 4096).
 
 %% ---------------------------------
 %% Logging mechanism
 
-%% Print in standard output
--define(PRINT(Format, Args),
-    io:format(Format, Args)).
+-define(PRINT(Format, Args), io:format(Format, Args)).
 
 -define(DEBUG(Format, Args),
-    ejabberd_logger:debug_msg(?MODULE,?LINE,Format, Args)).
+	ejabberd_logger:debug_msg(?MODULE, ?LINE, Format,
+				  Args)).
 
 -define(INFO_MSG(Format, Args),
-    ejabberd_logger:info_msg(?MODULE,?LINE,Format, Args)).
-			      
+	ejabberd_logger:info_msg(?MODULE, ?LINE, Format, Args)).
+
 -define(WARNING_MSG(Format, Args),
-    ejabberd_logger:warning_msg(?MODULE,?LINE,Format, Args)).
-			      
+	ejabberd_logger:warning_msg(?MODULE, ?LINE, Format,
+				    Args)).
+
 -define(ERROR_MSG(Format, Args),
-    ejabberd_logger:error_msg(?MODULE,?LINE,Format, Args)).
+	ejabberd_logger:error_msg(?MODULE, ?LINE, Format,
+				  Args)).
 
 -define(CRITICAL_MSG(Format, Args),
-    ejabberd_logger:critical_msg(?MODULE,?LINE,Format, Args)).
-
+	ejabberd_logger:critical_msg(?MODULE, ?LINE, Format,
+				     Args)).

src/ejabberd_admin.erl

@@ -5,7 +5,7 @@
 %%% Created :  7 May 2006 by Mickael Remond <mremond@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -30,7 +30,9 @@
 -export([start/0, stop/0,
 	 %% Server
 	 status/0, reopen_log/0,
+         stop_migrate/1, migrate/1,
 	 stop_kindly/2, send_service_message_all_mucs/2,
+	 registered_vhosts/0,
 	 %% Erlang
 	 update_list/0, update/1,
 	 %% Accounts
@@ -47,7 +49,9 @@
 	 install_fallback_mnesia/1,
 	 dump_to_textfile/1, dump_to_textfile/2,
 	 mnesia_change_nodename/4,
-	 restore/1 % Still used by some modules
+	 restore/1, % Still used by some modules
+	 moderate_room_history/2,
+	 persist_recent_messages/0
 	]).
 
 -include("ejabberd.hrl").
@@ -92,6 +96,17 @@ commands() ->
 			module = ?MODULE, function = stop_kindly,
 			args = [{delay, integer}, {announcement, string}],
 			result = {res, rescode}},
+     #ejabberd_commands{name = migrate, tags = [server],
+                        desc = "Try to migrate C2S/BOSH/MUC sessions to other nodes",
+                        module = ?MODULE, function = migrate,
+			args = [{delay, integer}],
+			result = {res, rescode}},
+     #ejabberd_commands{name = stop_migrate, tags = [server],
+                        desc = "Try to migrate C2S/BOSH/MUC sessions to other"
+                        "nodes and then stop",
+                        module = ?MODULE, function = stop_migrate,
+			args = [{delay, integer}],
+			result = {res, rescode}},
      #ejabberd_commands{name = get_loglevel, tags = [logs, server],
 			desc = "Get the current loglevel",
 			module = ejabberd_loglevel, function = get,
@@ -115,18 +130,23 @@ commands() ->
      #ejabberd_commands{name = register, tags = [accounts],
 			desc = "Register a user",
 			module = ?MODULE, function = register,
-			args = [{user, string}, {host, string}, {password, string}],
+			args = [{user, binary}, {host, binary}, {password, binary}],
 			result = {res, restuple}},
      #ejabberd_commands{name = unregister, tags = [accounts],
 			desc = "Unregister a user",
 			module = ?MODULE, function = unregister,
-			args = [{user, string}, {host, string}],
+			args = [{user, binary}, {host, binary}],
 			result = {res, restuple}},
      #ejabberd_commands{name = registered_users, tags = [accounts],
 			desc = "List all registered users in HOST",
 			module = ?MODULE, function = registered_users,
-			args = [{host, string}],
+			args = [{host, binary}],
 			result = {users, {list, {username, string}}}},
+	 #ejabberd_commands{name = registered_vhosts, tags = [server],
+			desc = "List all registered vhosts in SERVER",
+			module = ?MODULE, function = registered_vhosts,
+			args = [],
+			result = {vhosts, {list, {vhost, string}}}},
 
      #ejabberd_commands{name = import_file, tags = [mnesia],
 			desc = "Import user data from jabberd14 spool file",
@@ -151,6 +171,11 @@ commands() ->
 			module = ejabberd_piefxis, function = export_host,
 			args = [{dir, string}, {host, string}], result = {res, rescode}},
 
+     #ejabberd_commands{name = export_odbc, tags = [mnesia, odbc],
+                        desc = "Export virtual host information from Mnesia tables to a SQL file.",
+                        module = ejd2odbc, function = export,
+                        args = [{host, string}, {file, string}], result = {res, rescode}},
+
      #ejabberd_commands{name = delete_expired_messages, tags = [purge],
 			desc = "Delete expired offline messages from database",
 			module = ?MODULE, function = delete_expired_messages,
@@ -200,9 +225,40 @@ commands() ->
      #ejabberd_commands{name = install_fallback, tags = [mnesia],
 			desc = "Install the database from a fallback file",
 			module = ?MODULE, function = install_fallback_mnesia,
-			args = [{file, string}], result = {res, restuple}}
+			args = [{file, string}], result = {res, restuple}},
+     #ejabberd_commands{name = moderate_room_history, tags = [server],
+	     		desc = "Clean messages from the short-term MUC storage",
+			module = ?MODULE, function = moderate_room_history,
+			args = [{room, string}, {nick, string}],
+			result = {res, restuple}},
+     #ejabberd_commands{name = persist_recent_messages, tags = [server],
+	     		desc = "Force recent muc messages to be savd on DB",
+			module = ?MODULE, function = persist_recent_messages,
+			args = [],
+			result = {res, restuple}}
     ].
 
+%%%
+%%% MUC moderation
+%%%
+%%% Same room can be replicated into different nodes,
+%%% call all of them.
+moderate_room_history(Room, Nick) ->
+	{Res, BadNodes} = rpc:multicall(mod_muc, moderate_room_history, [Room, Nick], 5000),
+	B = case BadNodes of
+		[] ->
+			"";
+		_ ->
+			io_lib:format("Bad nodes: ~p", [BadNodes])
+	end,
+	{ok, io_lib:format("Deleted: ~p ~s", [Res, B])}.
+
+persist_recent_messages() ->
+	Saved = [ {Host, mod_muc:persist_recent_messages(Host)} || Host <- ?MYHOSTS],
+	R = lists:map(fun({Host, {RoomsPersisted, Messages}}) -> 
+				io_lib:format("Host '~s' , ~p messages persisted in ~p rooms\n", [Host, Messages, RoomsPersisted])
+	       	end, Saved),
+	{ok,io_lib:format("~s", [R])}.
 
 %%%
 %%% Server management
@@ -284,15 +340,77 @@ stop_kindly(DelaySeconds, AnnouncementText) ->
     ok.
 
 send_service_message_all_mucs(Subject, AnnouncementText) ->
-    Message = io_lib:format("~s~n~s", [Subject, AnnouncementText]),
+    Message = list_to_binary(
+                io_lib:format("~s~n~s", [Subject, AnnouncementText])),
     lists:foreach(
       fun(ServerHost) ->
 	      MUCHost = gen_mod:get_module_opt_host(
-			  ServerHost, mod_muc, "conference.@HOST@"),
+			  ServerHost, mod_muc, <<"conference.@HOST@">>),
 	      mod_muc:broadcast_service_message(MUCHost, Message)
       end,
       ?MYHOSTS).
 
+%%%
+%%% Migrate w/o stopping
+%%%
+migrate(DelaySeconds) ->
+    WaitingDesc = io_lib:format("Starting migration, this will take ~p seconds",
+                                [DelaySeconds]),
+    Steps = [
+	     {"Stopping ejabberd port listeners",
+	      ejabberd_listener, stop_listeners, []},
+             {WaitingDesc, ejabberd_cluster, shutdown_migrate,
+              [DelaySeconds * 1000]}
+            ],
+    NumberLast = length(Steps),
+    TimestampStart = calendar:datetime_to_gregorian_seconds({date(), time()}),
+    lists:foldl(
+      fun({Desc, Mod, Func, Args}, NumberThis) ->
+	      SecondsDiff =
+		  calendar:datetime_to_gregorian_seconds({date(), time()})
+		  - TimestampStart,
+	      io:format("[~p/~p ~ps] ~s... ",
+			[NumberThis, NumberLast, SecondsDiff, Desc]),
+	      Result = apply(Mod, Func, Args),
+	      io:format("~p~n", [Result]),
+	      NumberThis+1
+      end,
+      1,
+      Steps),
+    ok.
+
+%%%
+%%% Migrate and stop
+%%%
+stop_migrate(DelaySeconds) ->
+    WaitingDesc = io_lib:format("Starting migration, this will take ~p seconds",
+                                [DelaySeconds]),
+    Steps = [
+	     {"Stopping ejabberd port listeners",
+	      ejabberd_listener, stop_listeners, []},
+             {WaitingDesc, ejabberd_cluster, shutdown_migrate,
+              [DelaySeconds * 1000]},
+	     {"Stopping ejabberd", application, stop, [ejabberd]},
+	     {"Stopping Mnesia", mnesia, stop, []},
+	     {"Stopping Erlang node", init, stop, []}
+    ],
+    NumberLast = length(Steps),
+    TimestampStart = calendar:datetime_to_gregorian_seconds({date(), time()}),
+    lists:foldl(
+      fun({Desc, Mod, Func, Args}, NumberThis) ->
+	      SecondsDiff =
+		  calendar:datetime_to_gregorian_seconds({date(), time()})
+		  - TimestampStart,
+	      io:format("[~p/~p ~ps] ~s... ",
+			[NumberThis, NumberLast, SecondsDiff, Desc]),
+	      Result = apply(Mod, Func, Args),
+	      io:format("~p~n", [Result]),
+	      NumberThis+1
+      end,
+      1,
+      Steps),
+    ok.
+
 %%%
 %%% ejabberd_update
 %%%
@@ -308,6 +426,8 @@ update("all") ->
 update(ModStr) ->
     update_module(ModStr).
 
+update_module(ModuleNameBin) when is_binary(ModuleNameBin) ->
+    update_module(binary_to_list(ModuleNameBin));
 update_module(ModuleNameString) ->
     ModuleName = list_to_atom(ModuleNameString),
     case ejabberd_update:update([ModuleName]) of
@@ -342,6 +462,8 @@ registered_users(Host) ->
     SUsers = lists:sort(Users),
     lists:map(fun({U, _S}) -> U end, SUsers).
 
+registered_vhosts() ->
+	?MYHOSTS.
 
 %%%
 %%% Migration management

src/ejabberd_app.erl

@@ -5,7 +5,7 @@
 %%% Created : 31 Jan 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -57,17 +57,19 @@ start(normal, _Args) ->
     ejabberd_config:start(),
     ejabberd_check:config(),
     connect_nodes(),
-    %% Loading ASN.1 driver explicitly to avoid races in LDAP
-    catch asn1rt:load_driver(),
     Sup = ejabberd_sup:start_link(),
     ejabberd_rdbms:start(),
+    ejabberd_riak_sup:start(),
     ejabberd_auth:start(),
     cyrsasl:start(),
     % Profiling
     %ejabberd_debug:eprof_start(),
     %ejabberd_debug:fprof_start(),
     maybe_add_nameservers(),
+    {ok, Pid} = ejabberd_cluster:start(),
     start_modules(),
+    ejabberd_cluster:announce(Pid),
+    ejabberd_node_groups:start(),
     ejabberd_listener:start_listeners(),
     ?INFO_MSG("ejabberd ~s is started in the node ~p", [?VERSION, node()]),
     Sup;
@@ -78,6 +80,7 @@ start(_, _) ->
 %% This function is called when an application is about to be stopped,
 %% before shutting down the processes of the application.
 prep_stop(State) ->
+    ejabberd_cluster:shutdown(),
     stop_modules(),
     ejabberd_admin:stop(),
     broadcast_c2s_shutdown(),
@@ -134,41 +137,48 @@ db_init() ->
 start_modules() ->
     lists:foreach(
       fun(Host) ->
-	      case ejabberd_config:get_local_option({modules, Host}) of
-		  undefined ->
-		      ok;
-		  Modules ->
-		      lists:foreach(
-			fun({Module, Args}) ->
-				gen_mod:start_module(Host, Module, Args)
-			end, Modules)
-	      end
+              Modules = ejabberd_config:get_local_option(
+                          {modules, Host},
+                          fun(Mods) ->
+                                  lists:map(
+                                    fun({M, A}) when is_atom(M), is_list(A) ->
+                                            {M, A}
+                                    end, Mods)
+                          end, []),
+              lists:foreach(
+                fun({Module, Args}) ->
+                        gen_mod:start_module(Host, Module, Args)
+                end, Modules)
       end, ?MYHOSTS).
 
 %% Stop all the modules in all the hosts
 stop_modules() ->
     lists:foreach(
       fun(Host) ->
-	      case ejabberd_config:get_local_option({modules, Host}) of
-		  undefined ->
-		      ok;
-		  Modules ->
-		      lists:foreach(
-			fun({Module, _Args}) ->
-				gen_mod:stop_module_keep_config(Host, Module)
-			end, Modules)
-	      end
+              Modules = ejabberd_config:get_local_option(
+                          {modules, Host},
+                          fun(Mods) ->
+                                  lists:map(
+                                    fun({M, A}) when is_atom(M), is_list(A) ->
+                                            {M, A}
+                                    end, Mods)
+                          end, []),
+              lists:foreach(
+                fun({Module, _Args}) ->
+                        gen_mod:stop_module_keep_config(Host, Module)
+                end, Modules)
       end, ?MYHOSTS).
 
 connect_nodes() ->
-    case ejabberd_config:get_local_option(cluster_nodes) of
-	undefined ->
-	    ok;
-	Nodes when is_list(Nodes) ->
-	    lists:foreach(fun(Node) ->
-				  net_kernel:connect_node(Node)
-			  end, Nodes)
-    end.
+    Nodes = ejabberd_config:get_local_option(
+              cluster_nodes,
+              fun(Ns) ->
+                      true = lists:all(fun is_atom/1, Ns),
+                      Ns
+              end, []),
+    lists:foreach(fun(Node) ->
+                          net_kernel:connect_node(Node)
+                  end, Nodes).
 
 %% @spec () -> string()
 %% @doc Returns the full path to the ejabberd log file.

src/ejabberd_auth.erl

@@ -5,7 +5,7 @@
 %%% Created : 23 Nov 2002 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -27,357 +27,405 @@
 %% TODO: Use the functions in ejabberd auth to add and remove users.
 
 -module(ejabberd_auth).
+
 -author('alexey@process-one.net').
 
 %% External exports
--export([start/0,
-	 set_password/3,
-	 check_password/3,
-	 check_password/5,
-	 check_password_with_authmodule/3,
-	 check_password_with_authmodule/5,
-	 try_register/3,
-	 dirty_get_registered_users/0,
-	 get_vh_registered_users/1,
-	 get_vh_registered_users/2,
+-export([start/0, set_password/3, check_password/3,
+	 check_password/5, check_password_with_authmodule/3,
+	 check_password_with_authmodule/5, try_register/3,
+	 dirty_get_registered_users/0, get_vh_registered_users/1,
+	 get_vh_registered_users/2, export/1,
 	 get_vh_registered_users_number/1,
-	 get_vh_registered_users_number/2,
-	 get_password/2,
-	 get_password_s/2,
-	 get_password_with_authmodule/2,
-	 is_user_exists/2,
-	 is_user_exists_in_other_modules/3,
-	 remove_user/2,
-	 remove_user/3,
-	 plain_password_required/1,
-	 store_type/1,
-	 entropy/1
-	]).
+	 get_vh_registered_users_number/2, get_password/2,
+	 get_password_s/2, get_password_with_authmodule/2,
+	 is_user_exists/2, is_user_exists_in_other_modules/3,
+	 remove_user/2, remove_user/3, plain_password_required/1,
+	 store_type/1, entropy/1]).
 
 -export([auth_modules/1]).
 
+%% For benchmarking
+-record(passwd, {us = {<<"">>, <<"">>} :: {binary(), binary()} | '$1',
+                 password = <<"">> :: binary() | scram() | '_'}).
+
+-export([create_users/5]).
+
 -include("ejabberd.hrl").
 
-%%%----------------------------------------------------------------------
-%%% API
-%%%----------------------------------------------------------------------
-start() ->
-    lists:foreach(
-      fun(Host) ->
-	      lists:foreach(
-		fun(M) ->
-			M:start(Host)
-		end, auth_modules(Host))
-      end, ?MYHOSTS).
+-type opts() :: [{prefix, binary()} | {from, integer()} |
+                 {to, integer()} | {limit, integer()} |
+                 {offset, integer()}].
+
+-callback start(binary()) -> any().
+-callback plain_password_required() -> boolean().
+-callback store_type() -> plain | external | scram.
+-callback set_password(binary(), binary(), binary()) -> ok | {error, atom()}.
+-callback remove_user(binary(), binary()) -> any().
+-callback remove_user(binary(), binary(), binary()) -> any().
+-callback is_user_exists(binary(), binary()) -> boolean() | {error, atom()}.
+-callback check_password(binary(), binary(), binary()) -> boolean().
+-callback check_password(binary(), binary(), binary(), binary(),
+                         fun((binary()) -> binary())) -> boolean().
+-callback try_register(binary(), binary(), binary()) -> {atomic, atom()} |
+                                                        {error, atom()}.
+-callback dirty_get_registered_users() -> [{binary(), binary()}].
+-callback get_vh_registered_users(binary()) -> [{binary(), binary()}].
+-callback get_vh_registered_users(binary(), opts()) -> [{binary(), binary()}].
+-callback get_vh_registered_users_number(binary()) -> number().
+-callback get_vh_registered_users_number(binary(), opts()) -> number().
+-callback get_password(binary(), binary()) -> false | binary().
+-callback get_password_s(binary(), binary()) -> binary().
+
+start() ->
+    lists:foreach(fun (Host) ->
+			  lists:foreach(fun (M) -> M:start(Host) end,
+					auth_modules(Host))
+		  end,
+		  ?MYHOSTS).
 
-%% This is only executed by ejabberd_c2s for non-SASL auth client
 plain_password_required(Server) ->
-    lists:any(
-      fun(M) ->
-	      M:plain_password_required()
-      end, auth_modules(Server)).
+    lists:any(fun (M) -> M:plain_password_required() end,
+	      auth_modules(Server)).
 
 store_type(Server) ->
-    lists:foldl(
-      fun(_, external) ->
-	      external;
-	  (M, scram) ->
-	      case M:store_type() of
-		  external ->
-		      external;
-		  _Else ->
-		      scram
-		  end;
-	  (M, plain) ->
-	      M:store_type()
-      end, plain, auth_modules(Server)).
+    lists:foldl(fun (_, external) -> external;
+		    (M, scram) ->
+			case M:store_type() of
+			  external -> external;
+			  _Else -> scram
+			end;
+		    (M, plain) -> M:store_type()
+		end,
+		plain, auth_modules(Server)).
+
+-spec check_password(binary(), binary(), binary()) -> boolean().
 
-%% @doc Check if the user and password can login in server.
-%% @spec (User::string(), Server::string(), Password::string()) ->
-%%     true | false
 check_password(User, Server, Password) ->
-    case check_password_with_authmodule(User, Server, Password) of
-	{true, _AuthModule} -> true;
-	false -> false
+    case check_password_with_authmodule(User, Server,
+					Password)
+	of
+      {true, _AuthModule} -> true;
+      false -> false
     end.
 
-%% @doc Check if the user and password can login in server.
-%% @spec (User::string(), Server::string(), Password::string(),
-%%        Digest::string(), DigestGen::function()) ->
-%%     true | false
-check_password(User, Server, Password, Digest, DigestGen) ->
-    case check_password_with_authmodule(User, Server, Password,
-					Digest, DigestGen) of
-	{true, _AuthModule} -> true;
-	false -> false
+-spec check_password(binary(), binary(), binary(), binary(),
+                     fun((binary()) -> binary())) -> boolean().
+
+check_password(User, Server, Password, Digest,
+	       DigestGen) ->
+    case check_password_with_authmodule(User, Server,
+					Password, Digest, DigestGen)
+	of
+      {true, _AuthModule} -> true;
+      false -> false
     end.
 
-%% @doc Check if the user and password can login in server.
-%% The user can login if at least an authentication method accepts the user
-%% and the password.
-%% The first authentication method that accepts the credentials is returned.
-%% @spec (User::string(), Server::string(), Password::string()) ->
-%%     {true, AuthModule} | false
-%% where
-%%   AuthModule = ejabberd_auth_anonymous | ejabberd_auth_external
-%%                 | ejabberd_auth_internal | ejabberd_auth_ldap
-%%                 | ejabberd_auth_odbc | ejabberd_auth_pam
-check_password_with_authmodule(User, Server, Password) ->
-    check_password_loop(auth_modules(Server), [User, Server, Password]).
+-spec check_password_with_authmodule(binary(), binary(), binary()) -> false |
+                                                                      {true, atom()}.
 
-check_password_with_authmodule(User, Server, Password, Digest, DigestGen) ->
-    check_password_loop(auth_modules(Server), [User, Server, Password,
-					       Digest, DigestGen]).
+check_password_with_authmodule(User, Server,
+			       Password) ->
+    check_password_loop(auth_modules(Server),
+			[User, Server, Password]).
 
-check_password_loop([], _Args) ->
-    false;
+-spec check_password_with_authmodule(binary(), binary(), binary(), binary(),
+                                     fun((binary()) -> binary())) -> false |
+                                                                     {true, atom()}.
+
+check_password_with_authmodule(User, Server, Password,
+			       Digest, DigestGen) ->
+    check_password_loop(auth_modules(Server),
+			[User, Server, Password, Digest, DigestGen]).
+
+check_password_loop([], _Args) -> false;
 check_password_loop([AuthModule | AuthModules], Args) ->
     case apply(AuthModule, check_password, Args) of
-	true ->
-	    {true, AuthModule};
-	false ->
-	    check_password_loop(AuthModules, Args)
+      true -> {true, AuthModule};
+      false -> check_password_loop(AuthModules, Args)
     end.
 
+-spec set_password(binary(), binary(), binary()) -> ok |
+                                                    {error, atom()}.
 
-%% @spec (User::string(), Server::string(), Password::string()) ->
-%%       ok | {error, ErrorType}
-%% where ErrorType = empty_password | not_allowed | invalid_jid
-set_password(_User, _Server, "") ->
-    %% We do not allow empty password
+set_password(_User, _Server, <<"">>) ->
     {error, empty_password};
 set_password(User, Server, Password) ->
-    lists:foldl(
-      fun(M, {error, _}) ->
-	      M:set_password(User, Server, Password);
-	 (_M, Res) ->
-	      Res
-      end, {error, not_allowed}, auth_modules(Server)).
+    lists:foldl(fun (M, {error, _}) ->
+			M:set_password(User, Server, Password);
+		    (_M, Res) -> Res
+		end,
+		{error, not_allowed}, auth_modules(Server)).
 
-%% @spec (User, Server, Password) -> {atomic, ok} | {atomic, exists} | {error, not_allowed}
-try_register(_User, _Server, "") ->
-    %% We do not allow empty password
-    {error, not_allowed};    
+-spec try_register(binary(), binary(), binary()) -> {atomic, atom()} |
+                                                    {error, atom()}.
+
+try_register(_User, _Server, <<"">>) ->
+    {error, not_allowed};
 try_register(User, Server, Password) ->
-    case is_user_exists(User,Server) of
-	true ->
-	    {atomic, exists};
-	false ->
-	    case lists:member(jlib:nameprep(Server), ?MYHOSTS) of
-		true ->
-		    Res = lists:foldl(
-		      fun(_M, {atomic, ok} = Res) ->
-			      Res;
-			 (M, _) ->
-			      M:try_register(User, Server, Password)
-		      end, {error, not_allowed}, auth_modules(Server)),
-		    case Res of
-			{atomic, ok} ->
-			    ejabberd_hooks:run(register_user, Server,
-					       [User, Server]),
-			    {atomic, ok};
-			_ -> Res
-		    end;
-		false ->
-		    {error, not_allowed}
-	    end
+    case is_user_exists(User, Server) of
+      true -> {atomic, exists};
+      false ->
+	  LServer = jlib:nameprep(Server),
+	  case lists:member(LServer, ?MYHOSTS) of
+	    true ->
+                MaxUsers = ejabberd_config:get_local_option({max_users, LServer},
+                                                            fun(X) when is_integer(X) -> X end, no_limit),
+                RegAllowed = case MaxUsers of
+                                 no_limit ->
+                                     true;
+                                 Num ->
+                                     get_vh_registered_users_number(LServer) < Num
+                             end,
+                case RegAllowed of
+                    true ->
+                        Res = lists:foldl(fun (_M, {atomic, ok} = Res) -> Res;
+                                              (M, _) ->
+                                                  M:try_register(User, Server, Password)
+                                          end,
+                                          {error, not_allowed}, auth_modules(Server)),
+                        case Res of
+                            {atomic, ok} ->
+                                ejabberd_hooks:run(register_user, Server,
+                                                   [User, Server]),
+                                {atomic, ok};
+                            _ -> Res
+                        end;
+                    _ ->
+                        {error, too_many_users}
+                end;
+	    false -> {error, not_allowed}
+	  end
     end.
 
-%% Registered users list do not include anonymous users logged
-dirty_get_registered_users() ->
-    lists:flatmap(
-      fun(M) ->
-	      M:dirty_get_registered_users()
-      end, auth_modules()).
+-spec dirty_get_registered_users() -> [{binary(), binary()}].
+
+dirty_get_registered_users() ->
+    lists:flatmap(fun (M) -> M:dirty_get_registered_users()
+		  end,
+		  auth_modules()).
+
+-spec get_vh_registered_users(binary()) -> [{binary(), binary()}].
 
-%% Registered users list do not include anonymous users logged
 get_vh_registered_users(Server) ->
-    lists:flatmap(
-      fun(M) ->
-	      M:get_vh_registered_users(Server)
-      end, auth_modules(Server)).
+    lists:flatmap(fun (M) ->
+			  M:get_vh_registered_users(Server)
+		  end,
+		  auth_modules(Server)).
+
+-spec get_vh_registered_users(binary(), opts()) -> [{binary(), binary()}].
 
 get_vh_registered_users(Server, Opts) ->
-    lists:flatmap(
-      fun(M) ->
-		case erlang:function_exported(
-		       M, get_vh_registered_users, 2) of
-		    true ->
-			M:get_vh_registered_users(Server, Opts);
-		    false ->
-			M:get_vh_registered_users(Server)
-		end
-      end, auth_modules(Server)).
+    lists:flatmap(fun (M) ->
+			  case erlang:function_exported(M,
+							get_vh_registered_users,
+							2)
+			      of
+			    true -> M:get_vh_registered_users(Server, Opts);
+			    false -> M:get_vh_registered_users(Server)
+			  end
+		  end,
+		  auth_modules(Server)).
 
 get_vh_registered_users_number(Server) ->
-    lists:sum(
-      lists:map(
-	fun(M) ->
-		case erlang:function_exported(
-		       M, get_vh_registered_users_number, 1) of
-		    true ->
-			M:get_vh_registered_users_number(Server);
-		    false ->
-			length(M:get_vh_registered_users(Server))
-		end
-	end, auth_modules(Server))).
+    lists:sum(lists:map(fun (M) ->
+				case erlang:function_exported(M,
+							      get_vh_registered_users_number,
+							      1)
+				    of
+				  true ->
+				      M:get_vh_registered_users_number(Server);
+				  false ->
+				      length(M:get_vh_registered_users(Server))
+				end
+			end,
+			auth_modules(Server))).
+
+-spec get_vh_registered_users_number(binary(), opts()) -> number().
 
 get_vh_registered_users_number(Server, Opts) ->
-    lists:sum(
-      lists:map(
-	fun(M) ->
-		case erlang:function_exported(
-		       M, get_vh_registered_users_number, 2) of
-		    true ->
-			M:get_vh_registered_users_number(Server, Opts);
-		    false ->
-			length(M:get_vh_registered_users(Server))
-		end
-	end, auth_modules(Server))).
+    lists:sum(lists:map(fun (M) ->
+				case erlang:function_exported(M,
+							      get_vh_registered_users_number,
+							      2)
+				    of
+				  true ->
+				      M:get_vh_registered_users_number(Server,
+								       Opts);
+				  false ->
+				      length(M:get_vh_registered_users(Server))
+				end
+			end,
+			auth_modules(Server))).
+
+-spec get_password(binary(), binary()) -> false | binary().
 
-%% @doc Get the password of the user.
-%% @spec (User::string(), Server::string()) -> Password::string()
 get_password(User, Server) ->
-    lists:foldl(
-      fun(M, false) ->
-	      M:get_password(User, Server);
-	 (_M, Password) ->
-	      Password
-      end, false, auth_modules(Server)).
+    lists:foldl(fun (M, false) ->
+			M:get_password(User, Server);
+		    (_M, Password) -> Password
+		end,
+		false, auth_modules(Server)).
+
+-spec get_password_s(binary(), binary()) -> binary().
 
 get_password_s(User, Server) ->
     case get_password(User, Server) of
-	false ->
-	    "";
-	Password when is_list(Password) ->
-	    Password;
-	_ ->
-	    ""
+      false -> <<"">>;
+      Password -> Password
     end.
 
-%% @doc Get the password of the user and the auth module.
-%% @spec (User::string(), Server::string()) ->
-%%     {Password::string(), AuthModule::atom()} | {false, none}
+-spec get_password_with_authmodule(binary(), binary()) -> {false | binary(), atom()}.
+
 get_password_with_authmodule(User, Server) ->
-    lists:foldl(
-      fun(M, {false, _}) ->
-	      {M:get_password(User, Server), M};
-	 (_M, {Password, AuthModule}) ->
-	      {Password, AuthModule}
-      end, {false, none}, auth_modules(Server)).
+    lists:foldl(fun (M, {false, _}) ->
+			{M:get_password(User, Server), M};
+		    (_M, {Password, AuthModule}) -> {Password, AuthModule}
+		end,
+		{false, none}, auth_modules(Server)).
+
+-spec is_user_exists(binary(), binary()) -> boolean().
 
-%% Returns true if the user exists in the DB or if an anonymous user is logged
-%% under the given name
 is_user_exists(User, Server) ->
-    lists:any(
-      fun(M) ->
-	      case M:is_user_exists(User, Server) of
-		  {error, Error} ->
-		      ?ERROR_MSG("The authentication module ~p returned an "
-				 "error~nwhen checking user ~p in server ~p~n"
-				 "Error message: ~p",
-				 [M, User, Server, Error]),
-		      false;
-		  Else ->
-		      Else
-	      end
-      end, auth_modules(Server)).
+    lists:any(fun (M) ->
+		      case M:is_user_exists(User, Server) of
+			{error, Error} ->
+			    ?ERROR_MSG("The authentication module ~p returned "
+				       "an error~nwhen checking user ~p in server "
+				       "~p~nError message: ~p",
+				       [M, User, Server, Error]),
+			    false;
+			Else -> Else
+		      end
+	      end,
+	      auth_modules(Server)).
+
+-spec is_user_exists_in_other_modules(atom(), binary(), binary()) -> boolean() | maybe.
 
-%% Check if the user exists in all authentications module except the module
-%% passed as parameter
-%% @spec (Module::atom(), User, Server) -> true | false | maybe
 is_user_exists_in_other_modules(Module, User, Server) ->
-    is_user_exists_in_other_modules_loop(
-      auth_modules(Server)--[Module],
-      User, Server).
-is_user_exists_in_other_modules_loop([], _User, _Server) ->
+    is_user_exists_in_other_modules_loop(auth_modules(Server)
+					   -- [Module],
+					 User, Server).
+
+is_user_exists_in_other_modules_loop([], _User,
+				     _Server) ->
     false;
-is_user_exists_in_other_modules_loop([AuthModule|AuthModules], User, Server) ->
+is_user_exists_in_other_modules_loop([AuthModule
+				      | AuthModules],
+				     User, Server) ->
     case AuthModule:is_user_exists(User, Server) of
-	true ->
-	    true;
-	false ->
-	    is_user_exists_in_other_modules_loop(AuthModules, User, Server);
-	{error, Error} ->
-	    ?DEBUG("The authentication module ~p returned an error~nwhen "
-		   "checking user ~p in server ~p~nError message: ~p",
-		   [AuthModule, User, Server, Error]),
-	    maybe
+      true -> true;
+      false ->
+	  is_user_exists_in_other_modules_loop(AuthModules, User,
+					       Server);
+      {error, Error} ->
+	  ?DEBUG("The authentication module ~p returned "
+		 "an error~nwhen checking user ~p in server "
+		 "~p~nError message: ~p",
+		 [AuthModule, User, Server, Error]),
+	  maybe
     end.
 
+-spec remove_user(binary(), binary()) -> ok.
 
-%% @spec (User, Server) -> ok
-%% @doc Remove user.
-%% Note: it may return ok even if there was some problem removing the user.
 remove_user(User, Server) ->
-    lists:foreach(
-      fun(M) ->
-	      M:remove_user(User, Server)
-      end, auth_modules(Server)),
-    ejabberd_hooks:run(remove_user, jlib:nameprep(Server), [User, Server]),
+    lists:foreach(fun (M) -> M:remove_user(User, Server)
+		  end,
+		  auth_modules(Server)),
+    ejabberd_hooks:run(remove_user, jlib:nameprep(Server),
+		       [User, Server]),
     ok.
 
-%% @spec (User, Server, Password) -> ok | not_exists | not_allowed | bad_request | error
-%% @doc Try to remove user if the provided password is correct.
-%% The removal is attempted in each auth method provided:
-%% when one returns 'ok' the loop stops;
-%% if no method returns 'ok' then it returns the error message indicated by the last method attempted.
+-spec remove_user(binary(), binary(), binary()) -> any().
+
 remove_user(User, Server, Password) ->
-    R = lists:foldl(
-      fun(_M, ok = Res) ->
-	      Res;
-	 (M, _) ->
-	      M:remove_user(User, Server, Password)
-      end, error, auth_modules(Server)),
+    R = lists:foldl(fun (_M, ok = Res) -> Res;
+			(M, _) -> M:remove_user(User, Server, Password)
+		    end,
+		    error, auth_modules(Server)),
     case R of
-		ok -> ejabberd_hooks:run(remove_user, jlib:nameprep(Server), [User, Server]);
-		_ -> none
+      ok ->
+	  ejabberd_hooks:run(remove_user, jlib:nameprep(Server),
+			     [User, Server]);
+      _ -> none
     end,
     R.
 
-%% @spec (IOList) -> non_negative_float()
 %% @doc Calculate informational entropy.
-entropy(IOList) ->
-    case binary_to_list(iolist_to_binary(IOList)) of
-	"" ->
-	    0.0;
-	S ->
-	    Set = lists:foldl(
-		    fun(C, [Digit, Printable, LowLetter, HiLetter, Other]) ->
-			    if C >= $a, C =< $z ->
-				    [Digit, Printable, 26, HiLetter, Other];
-			       C >= $0, C =< $9 ->
-				    [9, Printable, LowLetter, HiLetter, Other];
-			       C >= $A, C =< $Z ->
-				    [Digit, Printable, LowLetter, 26, Other];
-			       C >= 16#21, C =< 16#7e ->
-				    [Digit, 33, LowLetter, HiLetter, Other];
-			       true ->
-				    [Digit, Printable, LowLetter, HiLetter, 128]
-			    end
-		    end, [0, 0, 0, 0, 0], S),
-	    length(S) * math:log(lists:sum(Set))/math:log(2)
+entropy(B) ->
+    case binary_to_list(B) of
+      "" -> 0.0;
+      S ->
+	  Set = lists:foldl(fun (C,
+				 [Digit, Printable, LowLetter, HiLetter,
+				  Other]) ->
+				    if C >= $a, C =< $z ->
+					   [Digit, Printable, 26, HiLetter,
+					    Other];
+				       C >= $0, C =< $9 ->
+					   [9, Printable, LowLetter, HiLetter,
+					    Other];
+				       C >= $A, C =< $Z ->
+					   [Digit, Printable, LowLetter, 26,
+					    Other];
+				       C >= 33, C =< 126 ->
+					   [Digit, 33, LowLetter, HiLetter,
+					    Other];
+				       true ->
+					   [Digit, Printable, LowLetter,
+					    HiLetter, 128]
+				    end
+			    end,
+			    [0, 0, 0, 0, 0], S),
+	  length(S) * math:log(lists:sum(Set)) / math:log(2)
     end.
 
-%%%----------------------------------------------------------------------
-%%% Internal functions
-%%%----------------------------------------------------------------------
-%% Return the lists of all the auth modules actually used in the
-%% configuration
 auth_modules() ->
-    lists:usort(
-      lists:flatmap(
-	fun(Server) ->
-		auth_modules(Server)
-	end, ?MYHOSTS)).
+    lists:usort(lists:flatmap(fun (Server) ->
+				      auth_modules(Server)
+			      end,
+			      ?MYHOSTS)).
+
+-spec auth_modules(binary()) -> [atom()].
 
-%% Return the list of authenticated modules for a given host
 auth_modules(Server) ->
     LServer = jlib:nameprep(Server),
-    Method = ejabberd_config:get_local_option({auth_method, LServer}),
-    Methods = if
-		  Method == undefined -> [];
-		  is_list(Method) -> Method;
-		  is_atom(Method) -> [Method]
-	      end,
-    [list_to_atom("ejabberd_auth_" ++ atom_to_list(M)) || M <- Methods].
+    Methods = ejabberd_config:get_local_option(
+                {auth_method, LServer},
+                fun(V) when is_list(V) ->
+                        true = lists:all(fun is_atom/1, V),
+                        V;
+                   (V) when is_atom(V) ->
+                        [V]
+                end, []),
+    [jlib:binary_to_atom(<<"ejabberd_auth_",
+                           (jlib:atom_to_binary(M))/binary>>)
+     || M <- Methods].
+
+export(Server) ->
+    ejabberd_auth_internal:export(Server).
+
+-spec create_users(binary(), binary(), binary(),
+                   pos_integer(), gen_mod:db_type()) -> any().
+
+create_users(UserPattern, PassPattern, Server, Total, DBType) ->
+    lists:foreach(
+      fun(I) ->
+              LUser = jlib:nodeprep(
+                        iolist_to_binary([UserPattern, integer_to_list(I)])),
+              Pass = iolist_to_binary([PassPattern, integer_to_list(I)]),
+              LServer = jlib:nameprep(Server),
+              US = {LUser, LServer},
+              case DBType of
+                  mnesia ->
+                      mnesia:dirty_write(#passwd{us = US,
+                                                 password = Pass});
+                  riak ->
+                      ejabberd_riak:put(
+                        #passwd{us = US,
+                                password = Pass},
+                        [{'2i', [{<<"host">>, LServer}]}]);
+                  odbc ->
+                      erlang:error(odbc_not_supported)
+              end
+      end, lists:seq(1, Total)).

src/ejabberd_auth_anonymous.erl

@@ -5,7 +5,7 @@
 %%% Created : 17 Feb 2006 by Mickael Remond <mremond@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,229 +25,237 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_auth_anonymous).
+
 -author('mickael.remond@process-one.net').
 
--export([start/1,
-	 allow_anonymous/1,
-	 is_sasl_anonymous_enabled/1,
-	 is_login_anonymous_enabled/1,
-	 anonymous_user_exist/2,
-	 allow_multiple_connections/1,
-	 register_connection/3,
-	 unregister_connection/3
-	]).
+-behaviour(ejabberd_auth).
 
+-export([start/1, allow_anonymous/1,
+	 is_sasl_anonymous_enabled/1,
+	 is_login_anonymous_enabled/1, anonymous_user_exist/2,
+	 allow_multiple_connections/1, register_connection/3,
+	 unregister_migrated_connection/3,
+	 unregister_connection/3]).
 
 %% Function used by ejabberd_auth:
--export([login/2,
-	 set_password/3,
-	 check_password/3,
-	 check_password/5,
-	 try_register/3,
-	 dirty_get_registered_users/0,
-	 get_vh_registered_users/1,
-	 get_password/2,
-	 get_password/3,
-	 is_user_exists/2,
-	 remove_user/2,
-	 remove_user/3,
-	 store_type/0,
+-export([login/2, set_password/3, check_password/3,
+	 check_password/5, try_register/3,
+	 dirty_get_registered_users/0, get_vh_registered_users/1,
+         get_vh_registered_users/2, get_vh_registered_users_number/1,
+         get_vh_registered_users_number/2, get_password_s/2,
+	 get_password/2, get_password/3, is_user_exists/2,
+	 remove_user/2, remove_user/3, store_type/0,
 	 plain_password_required/0]).
 
 -include("ejabberd.hrl").
--include("jlib.hrl").
--record(anonymous, {us, sid}).
 
-%% Create the anonymous table if at least one virtual host has anonymous features enabled
-%% Register to login / logout events
+-include("jlib.hrl").
+
+-record(anonymous, {us = {<<"">>, <<"">>} :: {binary(), binary()},
+                    sid = {now(), self()} :: ejabberd_sm:sid()}).
+
 start(Host) ->
-    %% TODO: Check cluster mode
-    mnesia:create_table(anonymous, [{ram_copies, [node()]},
-				    {type, bag},
-				    {attributes, record_info(fields, anonymous)}]),
-    %% The hooks are needed to add / remove users from the anonymous tables
+    update_tables(),
+    mnesia:create_table(anonymous,
+			[{ram_copies, [node()]}, {type, bag},
+			 {local_content, true},
+			 {attributes, record_info(fields, anonymous)}]),
+    mnesia:add_table_copy(anonymous, node(), ram_copies),
     ejabberd_hooks:add(sm_register_connection_hook, Host,
 		       ?MODULE, register_connection, 100),
+    ejabberd_hooks:add(sm_remove_migrated_connection_hook,
+		       Host, ?MODULE, unregister_migrated_connection, 100),
     ejabberd_hooks:add(sm_remove_connection_hook, Host,
 		       ?MODULE, unregister_connection, 100),
     ok.
 
-%% Return true if anonymous is allowed for host or false otherwise
 allow_anonymous(Host) ->
     lists:member(?MODULE, ejabberd_auth:auth_modules(Host)).
 
-%% Return true if anonymous mode is enabled and if anonymous protocol is SASL
-%% anonymous protocol can be: sasl_anon|login_anon|both
 is_sasl_anonymous_enabled(Host) ->
     case allow_anonymous(Host) of
-	false -> false;
-	true ->
-	    case anonymous_protocol(Host) of
-		sasl_anon -> true;
-		both      -> true;
-		_Other    -> false
-	    end
+      false -> false;
+      true ->
+	  case anonymous_protocol(Host) of
+	    sasl_anon -> true;
+	    both -> true;
+	    _Other -> false
+	  end
     end.
 
-%% Return true if anonymous login is enabled on the server
-%% anonymous login can be use using standard authentication method (i.e. with
-%% clients that do not support anonymous login)
 is_login_anonymous_enabled(Host) ->
     case allow_anonymous(Host) of
-	false -> false;
-	true  ->
-	    case anonymous_protocol(Host) of
-		login_anon -> true;
-		both       -> true;
-		_Other     -> false
-	    end
+      false -> false;
+      true ->
+	  case anonymous_protocol(Host) of
+	    login_anon -> true;
+	    both -> true;
+	    _Other -> false
+	  end
     end.
 
-%% Return the anonymous protocol to use: sasl_anon|login_anon|both
-%% defaults to login_anon
 anonymous_protocol(Host) ->
-    case ejabberd_config:get_local_option({anonymous_protocol, Host}) of
-	sasl_anon  -> sasl_anon;
-	login_anon -> login_anon;
-	both       -> both;
-	_Other     -> sasl_anon
-    end.
+    ejabberd_config:get_local_option(
+      {anonymous_protocol, Host},
+      fun(sasl_anon) -> sasl_anon;
+         (login_anon) -> login_anon;
+         (both) -> both
+      end,
+      sasl_anon).
 
-%% Return true if multiple connections have been allowed in the config file
-%% defaults to false
 allow_multiple_connections(Host) ->
     ejabberd_config:get_local_option(
-      {allow_multiple_connections, Host}) =:= true.
+      {allow_multiple_connections, Host},
+      fun(V) when is_boolean(V) -> V end,
+      false).
 
-%% Check if user exist in the anonymus database
 anonymous_user_exist(User, Server) ->
     LUser = jlib:nodeprep(User),
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
-    case catch mnesia:dirty_read({anonymous, US}) of
-	[] ->
-	    false;
-	[_H|_T] ->
-	    true
+    Ss = case ejabberd_cluster:get_node(US) of
+	   Node when Node == node() ->
+	       catch mnesia:dirty_read({anonymous, US});
+	   Node ->
+	       catch rpc:call(Node, mnesia, dirty_read,
+			      [{anonymous, US}], 5000)
+	 end,
+    case Ss of
+      [_H | _T] -> true;
+      _ -> false
     end.
 
-%% Remove connection from Mnesia tables
 remove_connection(SID, LUser, LServer) ->
     US = {LUser, LServer},
-    F = fun() ->
-		mnesia:delete_object({anonymous, US, SID})
-        end,
-    mnesia:transaction(F).
+    F = fun () -> mnesia:delete_object({anonymous, US, SID})
+	end,
+    mnesia:async_dirty(F).
 
-%% Register connection
-register_connection(SID, #jid{luser = LUser, lserver = LServer}, Info) ->
-    AuthModule = xml:get_attr_s(auth_module, Info),
-    case AuthModule == ?MODULE of
-	true ->
-	    ejabberd_hooks:run(register_user, LServer, [LUser, LServer]),
-	    US = {LUser, LServer},
-	    mnesia:sync_dirty(
-	      fun() -> mnesia:write(#anonymous{us = US, sid=SID})
-	      end);
-	false ->
-	    ok
+register_connection(SID,
+		    #jid{luser = LUser, lserver = LServer}, Info) ->
+    AuthModule = list_to_atom(binary_to_list(xml:get_attr_s(<<"auth_module">>, Info))),
+    case AuthModule == (?MODULE) of
+      true ->
+	  ejabberd_hooks:run(register_user, LServer,
+			     [LUser, LServer]),
+	  US = {LUser, LServer},
+	  mnesia:async_dirty(fun () ->
+				     mnesia:write(#anonymous{us = US,
+							     sid = SID})
+			     end);
+      false -> ok
     end.
 
-%% Remove an anonymous user from the anonymous users table
-unregister_connection(SID, #jid{luser = LUser, lserver = LServer}, _) ->
-    purge_hook(anonymous_user_exist(LUser, LServer),
-	       LUser, LServer),
+unregister_connection(SID,
+		      #jid{luser = LUser, lserver = LServer}, _) ->
+    purge_hook(anonymous_user_exist(LUser, LServer), LUser,
+	       LServer),
     remove_connection(SID, LUser, LServer).
 
-%% Launch the hook to purge user data only for anonymous users
-purge_hook(false, _LUser, _LServer) ->
-    ok;
+unregister_migrated_connection(SID,
+			       #jid{luser = LUser, lserver = LServer}, _) ->
+    remove_connection(SID, LUser, LServer).
+
+purge_hook(false, _LUser, _LServer) -> ok;
 purge_hook(true, LUser, LServer) ->
-    ejabberd_hooks:run(anonymous_purge_hook, LServer, [LUser, LServer]).
+    ejabberd_hooks:run(anonymous_purge_hook, LServer,
+		       [LUser, LServer]).
 
 %% ---------------------------------
 %% Specific anonymous auth functions
 %% ---------------------------------
 
-%% When anonymous login is enabled, check the password for permenant users
-%% before allowing access
 check_password(User, Server, Password) ->
-    check_password(User, Server, Password, undefined, undefined).
-check_password(User, Server, _Password, _Digest, _DigestGen) ->
-    %% We refuse login for registered accounts (They cannot logged but
-    %% they however are "reserved")
-    case ejabberd_auth:is_user_exists_in_other_modules(?MODULE,
-						       User, Server) of
-	%% If user exists in other module, reject anonnymous authentication
-	true  -> false;
-	%% If we are not sure whether the user exists in other module, reject anon auth
-	maybe  -> false;
-	false -> login(User, Server)
+    check_password(User, Server, Password, undefined,
+		   undefined).
+
+check_password(User, Server, _Password, _Digest,
+	       _DigestGen) ->
+    case
+      ejabberd_auth:is_user_exists_in_other_modules(?MODULE,
+						    User, Server)
+	of
+      %% If user exists in other module, reject anonnymous authentication
+      true -> false;
+      %% If we are not sure whether the user exists in other module, reject anon auth
+      maybe -> false;
+      false -> login(User, Server)
     end.
 
 login(User, Server) ->
     case is_login_anonymous_enabled(Server) of
-	false -> false;
-	true  ->
-	    case anonymous_user_exist(User, Server) of
-		%% Reject the login if an anonymous user with the same login
-		%% is already logged and if multiple login has not been enable
-		%% in the config file.
-		true  -> allow_multiple_connections(Server);
-		%% Accept login and add user to the anonymous table
-		false -> true
-	    end
+      false -> false;
+      true ->
+	  case anonymous_user_exist(User, Server) of
+	    %% Reject the login if an anonymous user with the same login
+	    %% is already logged and if multiple login has not been enable
+	    %% in the config file.
+	    true -> allow_multiple_connections(Server);
+	    %% Accept login and add user to the anonymous table
+	    false -> true
+	  end
     end.
 
-%% When anonymous login is enabled, check that the user is permanent before
-%% changing its password
 set_password(User, Server, _Password) ->
     case anonymous_user_exist(User, Server) of
-	true ->
-	    ok;
-	false ->
-	    {error, not_allowed}
+      true -> ok;
+      false -> {error, not_allowed}
     end.
 
-%% When anonymous login is enabled, check if permanent users are allowed on
-%% the server:
 try_register(_User, _Server, _Password) ->
     {error, not_allowed}.
 
-dirty_get_registered_users() ->
-    [].
+dirty_get_registered_users() -> [].
 
 get_vh_registered_users(Server) ->
-    [{U, S} || {U, S, _R} <- ejabberd_sm:get_vh_session_list(Server)].
+    [{U, S}
+     || {U, S, _R}
+	    <- ejabberd_sm:get_vh_session_list(Server)].
 
+get_vh_registered_users(Server, _) ->
+    get_vh_registered_users(Server).
+
+get_vh_registered_users_number(Server) ->
+    length(get_vh_registered_users(Server)).
+
+get_vh_registered_users_number(Server, _) ->
+    get_vh_registered_users_number(Server).
 
-%% Return password of permanent user or false for anonymous users
 get_password(User, Server) ->
-    get_password(User, Server, "").
+    get_password(User, Server, <<"">>).
 
 get_password(User, Server, DefaultValue) ->
-    case anonymous_user_exist(User, Server) or login(User, Server) of
-	%% We return the default value if the user is anonymous
-	true ->
-	    DefaultValue;
-	%% We return the permanent user password otherwise
-	false ->
-	    false
+    case anonymous_user_exist(User, Server) or
+	   login(User, Server)
+	of
+      %% We return the default value if the user is anonymous
+      true -> DefaultValue;
+      %% We return the permanent user password otherwise
+      false -> false
+    end.
+
+get_password_s(User, Server) ->
+    case get_password(User, Server) of
+        false ->
+            <<"">>;
+        Password ->
+            Password
     end.
 
-%% Returns true if the user exists in the DB or if an anonymous user is logged
-%% under the given name
 is_user_exists(User, Server) ->
     anonymous_user_exist(User, Server).
 
-remove_user(_User, _Server) ->
-    {error, not_allowed}.
+remove_user(_User, _Server) -> {error, not_allowed}.
 
-remove_user(_User, _Server, _Password) ->
-    not_allowed.
+remove_user(_User, _Server, _Password) -> not_allowed.
 
-plain_password_required() ->
-    false.
+plain_password_required() -> false.
 
-store_type() ->
-	plain.
+update_tables() ->
+    case catch mnesia:table_info(anonymous, local_content)
+	of
+      false -> mnesia:delete_table(anonymous);
+      _ -> ok
+    end.
+
+store_type() -> plain.

src/ejabberd_auth_external.erl

@@ -5,7 +5,7 @@
 %%% Created : 12 Dec 2004 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,83 +25,78 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_auth_external).
+
 -author('alexey@process-one.net').
 
+-behaviour(ejabberd_auth).
+
 %% External exports
--export([start/1,
-	 set_password/3,
-	 check_password/3,
-	 check_password/5,
-	 try_register/3,
-	 dirty_get_registered_users/0,
-	 get_vh_registered_users/1,
+-export([start/1, set_password/3, check_password/3,
+	 check_password/5, try_register/3,
+	 dirty_get_registered_users/0, get_vh_registered_users/1,
 	 get_vh_registered_users/2,
 	 get_vh_registered_users_number/1,
-	 get_vh_registered_users_number/2,
-	 get_password/2,
-	 get_password_s/2,
-	 is_user_exists/2,
-	 remove_user/2,
-	 remove_user/3,
-	 store_type/0,
-	 plain_password_required/0
-	]).
+	 get_vh_registered_users_number/2, get_password/2,
+	 get_password_s/2, is_user_exists/2, remove_user/2,
+	 remove_user/3, store_type/0,
+	 plain_password_required/0]).
 
 -include("ejabberd.hrl").
 
-%%%----------------------------------------------------------------------
-%%% API
-%%%----------------------------------------------------------------------
 start(Host) ->
-    extauth:start(
-      Host, ejabberd_config:get_local_option({extauth_program, Host})),
+    Cmd = ejabberd_config:get_local_option(
+            {extauth_program, Host},
+            fun(V) ->
+                    binary_to_list(iolist_to_binary(V))
+            end,
+            "extauth"),
+    extauth:start(Host, Cmd),
     case check_cache_last_options(Host) of
-	cache ->
-	    ok = ejabberd_auth_internal:start(Host);
-	no_cache ->
-	    ok
+      cache -> ok = ejabberd_auth_internal:start(Host);
+      no_cache -> ok
     end.
 
 check_cache_last_options(Server) ->
-    %% if extauth_cache is enabled, then a mod_last module must also be enabled
     case get_cache_option(Server) of
-	false -> no_cache;
-	{true, _CacheTime} ->
-	    case get_mod_last_configured(Server) of
-		no_mod_last ->
-		    ?ERROR_MSG("In host ~p extauth is used, extauth_cache is enabled but "
-			       "mod_last is not enabled.", [Server]),
-		    no_cache;
-		_ -> cache
-	    end
+      false -> no_cache;
+      {true, _CacheTime} ->
+	  case get_mod_last_configured(Server) of
+	    no_mod_last ->
+		?ERROR_MSG("In host ~p extauth is used, extauth_cache "
+			   "is enabled but mod_last is not enabled.",
+			   [Server]),
+		no_cache;
+	    _ -> cache
+	  end
     end.
 
-plain_password_required() ->
-    true.
+plain_password_required() -> true.
 
-store_type() ->
-	external.
+store_type() -> external.
 
 check_password(User, Server, Password) ->
     case get_cache_option(Server) of
-	false -> check_password_extauth(User, Server, Password);
-	{true, CacheTime} -> check_password_cache(User, Server, Password, CacheTime)
+      false -> check_password_extauth(User, Server, Password);
+      {true, CacheTime} ->
+	  check_password_cache(User, Server, Password, CacheTime)
     end.
 
-check_password(User, Server, Password, _Digest, _DigestGen) ->
+check_password(User, Server, Password, _Digest,
+	       _DigestGen) ->
     check_password(User, Server, Password).
 
 set_password(User, Server, Password) ->
     case extauth:set_password(User, Server, Password) of
-	true -> set_password_internal(User, Server, Password),
-		ok;
-	_ -> {error, unknown_problem}
+      true ->
+	  set_password_internal(User, Server, Password), ok;
+      _ -> {error, unknown_problem}
     end.
 
 try_register(User, Server, Password) ->
     case get_cache_option(Server) of
-	false -> try_register_extauth(User, Server, Password);
-	{true, _CacheTime} -> try_register_external_cache(User, Server, Password)
+      false -> try_register_extauth(User, Server, Password);
+      {true, _CacheTime} ->
+	  try_register_external_cache(User, Server, Password)
     end.
 
 dirty_get_registered_users() ->
@@ -110,204 +105,185 @@ dirty_get_registered_users() ->
 get_vh_registered_users(Server) ->
     ejabberd_auth_internal:get_vh_registered_users(Server).
 
-get_vh_registered_users(Server, Data)  ->
-    ejabberd_auth_internal:get_vh_registered_users(Server, Data).
+get_vh_registered_users(Server, Data) ->
+    ejabberd_auth_internal:get_vh_registered_users(Server,
+						   Data).
 
 get_vh_registered_users_number(Server) ->
     ejabberd_auth_internal:get_vh_registered_users_number(Server).
 
 get_vh_registered_users_number(Server, Data) ->
-    ejabberd_auth_internal:get_vh_registered_users_number(Server, Data).
+    ejabberd_auth_internal:get_vh_registered_users_number(Server,
+							  Data).
 
-%% The password can only be returned if cache is enabled, cached info exists and is fresh enough.
 get_password(User, Server) ->
     case get_cache_option(Server) of
-	false -> false;
-	{true, CacheTime} -> get_password_cache(User, Server, CacheTime)
+      false -> false;
+      {true, CacheTime} ->
+	  get_password_cache(User, Server, CacheTime)
     end.
 
 get_password_s(User, Server) ->
     case get_password(User, Server) of
-	false -> [];
-	Other -> Other
+      false -> <<"">>;
+      Other -> Other
     end.
 
-%% @spec (User, Server) -> true | false | {error, Error}
 is_user_exists(User, Server) ->
     try extauth:is_user_exists(User, Server) of
-	Res -> Res
+      Res -> Res
     catch
-	_:Error -> {error, Error}
+      _:Error -> {error, Error}
     end.
 
 remove_user(User, Server) ->
     case extauth:remove_user(User, Server) of
-	false -> false;
-	true ->
-	    case get_cache_option(Server) of
-		false -> false;
-		{true, _CacheTime} ->
-		    ejabberd_auth_internal:remove_user(User, Server)
-	    end
+      false -> false;
+      true ->
+	  case get_cache_option(Server) of
+	    false -> false;
+	    {true, _CacheTime} ->
+		ejabberd_auth_internal:remove_user(User, Server)
+	  end
     end.
 
 remove_user(User, Server, Password) ->
     case extauth:remove_user(User, Server, Password) of
-	false -> false;
-	true ->
-	    case get_cache_option(Server) of
-		false -> false;
-		{true, _CacheTime} ->
-		    ejabberd_auth_internal:remove_user(User, Server, Password)
-	    end
+      false -> false;
+      true ->
+	  case get_cache_option(Server) of
+	    false -> false;
+	    {true, _CacheTime} ->
+		ejabberd_auth_internal:remove_user(User, Server,
+						   Password)
+	  end
     end.
 
 %%%
 %%% Extauth cache management
 %%%
 
-%% @spec (Host::string()) -> false | {true, CacheTime::integer()}
 get_cache_option(Host) ->
-    case ejabberd_config:get_local_option({extauth_cache, Host}) of
-	CacheTime when is_integer(CacheTime) -> {true, CacheTime};
-	_ -> false
+    case ejabberd_config:get_local_option(
+           {extauth_cache, Host},
+           fun(I) when is_integer(I), I > 0 -> I end) of
+        undefined -> false;
+        CacheTime -> {true, CacheTime}
     end.
 
-%% @spec (User, Server, Password) -> true | false
 check_password_extauth(User, Server, Password) ->
-    extauth:check_password(User, Server, Password) andalso Password /= "".
+    extauth:check_password(User, Server, Password) andalso
+      Password /= <<"">>.
 
-%% @spec (User, Server, Password) -> true | false
 try_register_extauth(User, Server, Password) ->
     extauth:try_register(User, Server, Password).
 
-check_password_cache(User, Server, Password, CacheTime) ->
+check_password_cache(User, Server, Password,
+		     CacheTime) ->
     case get_last_access(User, Server) of
-	online ->
-	    check_password_internal(User, Server, Password);
-	never ->
-	    check_password_external_cache(User, Server, Password);
-	mod_last_required ->
-	    ?ERROR_MSG("extauth is used, extauth_cache is enabled but mod_last is not enabled in that host", []),
-	    check_password_external_cache(User, Server, Password);
-	TimeStamp ->
-	    %% If last access exists, compare last access with cache refresh time
-	    case is_fresh_enough(TimeStamp, CacheTime) of
-		%% If no need to refresh, check password against Mnesia
-		true ->
-		    case check_password_internal(User, Server, Password) of
-			%% If password valid in Mnesia, accept it
-			true ->
-			    true;
-			%% Else (password nonvalid in Mnesia), check in extauth and cache result
-			false ->
-			    check_password_external_cache(User, Server, Password)
-		    end;
-		%% Else (need to refresh), check in extauth and cache result
-		false ->
-		    check_password_external_cache(User, Server, Password)
-	    end
+      online ->
+	  check_password_internal(User, Server, Password);
+      never ->
+	  check_password_external_cache(User, Server, Password);
+      mod_last_required ->
+	  ?ERROR_MSG("extauth is used, extauth_cache is enabled "
+		     "but mod_last is not enabled in that "
+		     "host",
+		     []),
+	  check_password_external_cache(User, Server, Password);
+      TimeStamp ->
+	  case is_fresh_enough(TimeStamp, CacheTime) of
+	    %% If no need to refresh, check password against Mnesia
+	    true ->
+		case check_password_internal(User, Server, Password) of
+		  %% If password valid in Mnesia, accept it
+		  true -> true;
+		  %% Else (password nonvalid in Mnesia), check in extauth and cache result
+		  false ->
+		      check_password_external_cache(User, Server, Password)
+		end;
+	    %% Else (need to refresh), check in extauth and cache result
+	    false ->
+		check_password_external_cache(User, Server, Password)
+	  end
     end.
 
 get_password_internal(User, Server) ->
     ejabberd_auth_internal:get_password(User, Server).
 
-%% @spec (User, Server, CacheTime) -> false | Password::string()
 get_password_cache(User, Server, CacheTime) ->
     case get_last_access(User, Server) of
-	online ->
-	    get_password_internal(User, Server);
-	never ->
-	    false;
-	mod_last_required ->
-	    ?ERROR_MSG("extauth is used, extauth_cache is enabled but mod_last is not enabled in that host", []),
-	    false;
-	TimeStamp ->
-	    case is_fresh_enough(TimeStamp, CacheTime) of
-		true ->
-		    get_password_internal(User, Server);
-		false ->
-		    false
-	    end
+      online -> get_password_internal(User, Server);
+      never -> false;
+      mod_last_required ->
+	  ?ERROR_MSG("extauth is used, extauth_cache is enabled "
+		     "but mod_last is not enabled in that "
+		     "host",
+		     []),
+	  false;
+      TimeStamp ->
+	  case is_fresh_enough(TimeStamp, CacheTime) of
+	    true -> get_password_internal(User, Server);
+	    false -> false
+	  end
     end.
 
-
-%% Check the password using extauth; if success then cache it
 check_password_external_cache(User, Server, Password) ->
     case check_password_extauth(User, Server, Password) of
-	true ->
-	    set_password_internal(User, Server, Password), true;
-	false ->
-	    false
+      true ->
+	  set_password_internal(User, Server, Password), true;
+      false -> false
     end.
 
-%% Try to register using extauth; if success then cache it
 try_register_external_cache(User, Server, Password) ->
     case try_register_extauth(User, Server, Password) of
-	{atomic, ok} = R ->
-	    set_password_internal(User, Server, Password),
-	    R;
-	_ -> {error, not_allowed}
+      {atomic, ok} = R ->
+	  set_password_internal(User, Server, Password), R;
+      _ -> {error, not_allowed}
     end.
 
-%% @spec (User, Server, Password) -> true | false
 check_password_internal(User, Server, Password) ->
-    ejabberd_auth_internal:check_password(User, Server, Password).
+    ejabberd_auth_internal:check_password(User, Server,
+					  Password).
 
-%% @spec (User, Server, Password) -> ok | {error, invalid_jid}
 set_password_internal(User, Server, Password) ->
-    ejabberd_auth_internal:set_password(User, Server, Password).
+    ejabberd_auth_internal:set_password(User, Server,
+					Password).
 
-%% @spec (TimeLast, CacheTime) -> true | false
-%%       TimeLast = online | never | integer()
-%%       CacheTime = integer() | false
-is_fresh_enough(online, _CacheTime) ->
-    true;
-is_fresh_enough(never, _CacheTime) ->
-    false;
 is_fresh_enough(TimeStampLast, CacheTime) ->
     {MegaSecs, Secs, _MicroSecs} = now(),
     Now = MegaSecs * 1000000 + Secs,
-    (TimeStampLast + CacheTime > Now).
+    TimeStampLast + CacheTime > Now.
 
-%% @spec (User, Server) -> online | never | mod_last_required | TimeStamp::integer()
-%% Code copied from mod_configure.erl
-%% Code copied from web/ejabberd_web_admin.erl
-%% TODO: Update time format to XEP-0202: Entity Time
 get_last_access(User, Server) ->
     case ejabberd_sm:get_user_resources(User, Server) of
-	[] ->
-	    _US = {User, Server},
-	    case get_last_info(User, Server) of
-		mod_last_required ->
-		    mod_last_required;
-		not_found ->
-		    never;
-		{ok, Timestamp, _Status} ->
-		    Timestamp
-	    end;
-	_ ->
-	    online
-    end.
-%% @spec (User, Server) -> {ok, Timestamp, Status} | not_found | mod_last_required
-get_last_info(User, Server) ->
-    case get_mod_last_enabled(Server) of
-	mod_last -> mod_last:get_last_info(User, Server);
-	no_mod_last -> mod_last_required
+      [] ->
+	  _US = {User, Server},
+	  case get_last_info(User, Server) of
+	    mod_last_required -> mod_last_required;
+	    not_found -> never;
+	    {ok, Timestamp, _Status} -> Timestamp
+	  end;
+      _ -> online
+    end.
+
+get_last_info(User, Server) ->
+    case get_mod_last_enabled(Server) of
+      mod_last -> mod_last:get_last_info(User, Server);
+      no_mod_last -> mod_last_required
     end.
 
-%% @spec (Server) -> mod_last | no_mod_last
 get_mod_last_enabled(Server) ->
     case gen_mod:is_loaded(Server, mod_last) of
-        true -> mod_last;
-	false -> no_mod_last
+      true -> mod_last;
+      false -> no_mod_last
     end.
 
 get_mod_last_configured(Server) ->
     case is_configured(Server, mod_last) of
-        true -> mod_last;
-	false -> no_mod_last
+      true -> mod_last;
+      false -> no_mod_last
     end.
 
 is_configured(Host, Module) ->
-    lists:keymember(Module, 1, ejabberd_config:get_local_option({modules, Host})).
+    gen_mod:is_loaded(Host, Module).

src/ejabberd_auth_internal.erl

@@ -5,7 +5,7 @@
 %%% Created : 12 Dec 2004 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,41 +25,36 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_auth_internal).
+
 -author('alexey@process-one.net').
 
+-behaviour(ejabberd_auth).
+
 %% External exports
--export([start/1,
-	 set_password/3,
-	 check_password/3,
-	 check_password/5,
-	 try_register/3,
-	 dirty_get_registered_users/0,
-	 get_vh_registered_users/1,
+-export([start/1, set_password/3, check_password/3,
+	 check_password/5, try_register/3,
+	 dirty_get_registered_users/0, get_vh_registered_users/1,
 	 get_vh_registered_users/2,
 	 get_vh_registered_users_number/1,
-	 get_vh_registered_users_number/2,
-	 get_password/2,
-	 get_password_s/2,
-	 is_user_exists/2,
-	 remove_user/2,
-	 remove_user/3,
-	 store_type/0,
-	 plain_password_required/0
-	]).
+	 get_vh_registered_users_number/2, get_password/2,
+	 get_password_s/2, is_user_exists/2, remove_user/2,
+	 remove_user/3, store_type/0, export/1,
+	 plain_password_required/0]).
 
 -include("ejabberd.hrl").
 
--record(passwd, {us, password}).
--record(reg_users_counter, {vhost, count}).
+-record(passwd, {us = {<<"">>, <<"">>} :: {binary(), binary()} | '$1',
+                 password = <<"">> :: binary() | scram() | '_'}).
+
+-record(reg_users_counter, {vhost = <<"">> :: binary(),
+                            count = 0 :: integer() | '$1'}).
 
 -define(SALT_LENGTH, 16).
 
-%%%----------------------------------------------------------------------
-%%% API
-%%%----------------------------------------------------------------------
 start(Host) ->
-    mnesia:create_table(passwd, [{disc_copies, [node()]},
-				 {attributes, record_info(fields, passwd)}]),
+    mnesia:create_table(passwd,
+			[{disc_copies, [node()]},
+			 {attributes, record_info(fields, passwd)}]),
     mnesia:create_table(reg_users_counter,
 			[{ram_copies, [node()]},
 			 {attributes, record_info(fields, reg_users_counter)}]),
@@ -72,22 +67,22 @@ update_reg_users_counter_table(Server) ->
     Set = get_vh_registered_users(Server),
     Size = length(Set),
     LServer = jlib:nameprep(Server),
-    F = fun() ->
-	    mnesia:write(#reg_users_counter{vhost = LServer,
-					    count = Size})
+    F = fun () ->
+		mnesia:write(#reg_users_counter{vhost = LServer,
+						count = Size})
 	end,
     mnesia:sync_dirty(F).
 
 plain_password_required() ->
     case is_scrammed() of
-	false -> false;
-	true -> true
+      false -> false;
+      true -> true
     end.
 
 store_type() ->
     case is_scrammed() of
-	false -> plain; %% allows: PLAIN DIGEST-MD5 SCRAM
-	true -> scram %% allows: PLAIN SCRAM
+      false -> plain; %% allows: PLAIN DIGEST-MD5 SCRAM
+      true -> scram %% allows: PLAIN SCRAM
     end.
 
 check_password(User, Server, Password) ->
@@ -95,174 +90,169 @@ check_password(User, Server, Password) ->
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
     case catch mnesia:dirty_read({passwd, US}) of
-	[#passwd{password = Password}] when is_list(Password) ->
-	    Password /= "";
-	[#passwd{password = Scram}] when is_record(Scram, scram) ->
-	    is_password_scram_valid(Password, Scram);
-	_ ->
-	    false
+      [#passwd{password = Password}]
+	  when is_binary(Password) ->
+	  Password /= <<"">>;
+      [#passwd{password = Scram}]
+	  when is_record(Scram, scram) ->
+	  is_password_scram_valid(Password, Scram);
+      _ -> false
     end.
 
-check_password(User, Server, Password, Digest, DigestGen) ->
+check_password(User, Server, Password, Digest,
+	       DigestGen) ->
     LUser = jlib:nodeprep(User),
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
     case catch mnesia:dirty_read({passwd, US}) of
-	[#passwd{password = Passwd}] when is_list(Passwd) ->
-	    DigRes = if
-			 Digest /= "" ->
-			     Digest == DigestGen(Passwd);
-			 true ->
-			     false
-		     end,
-	    if DigRes ->
-		    true;
-	       true ->
-		    (Passwd == Password) and (Password /= "")
-	    end;
-	[#passwd{password = Scram}] when is_record(Scram, scram) ->
-	    Passwd = base64:decode(Scram#scram.storedkey),
-	    DigRes = if
-			 Digest /= "" ->
-			     Digest == DigestGen(Passwd);
-			 true ->
-			     false
-		     end,
-	    if DigRes ->
-		    true;
-	       true ->
-		    (Passwd == Password) and (Password /= "")
-	    end;
-	_ ->
-	    false
+      [#passwd{password = Passwd}] when is_binary(Passwd) ->
+	  DigRes = if Digest /= <<"">> ->
+			  Digest == DigestGen(Passwd);
+		      true -> false
+		   end,
+	  if DigRes -> true;
+	     true -> (Passwd == Password) and (Password /= <<"">>)
+	  end;
+      [#passwd{password = Scram}]
+	  when is_record(Scram, scram) ->
+	  Passwd = jlib:decode_base64(Scram#scram.storedkey),
+	  DigRes = if Digest /= <<"">> ->
+			  Digest == DigestGen(Passwd);
+		      true -> false
+		   end,
+	  if DigRes -> true;
+	     true -> (Passwd == Password) and (Password /= <<"">>)
+	  end;
+      _ -> false
     end.
 
-%% @spec (User::string(), Server::string(), Password::string()) ->
-%%       ok | {error, invalid_jid}
 set_password(User, Server, Password) ->
     LUser = jlib:nodeprep(User),
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
-    if
-	(LUser == error) or (LServer == error) ->
-	    {error, invalid_jid};
-	true ->
-	    F = fun() ->
-			Password2 = case is_scrammed() and is_list(Password) of
-					true -> password_to_scram(Password);
-					false -> Password
-				    end,
-			mnesia:write(#passwd{us = US,
-					     password = Password2})
-		end,
-	    {atomic, ok} = mnesia:transaction(F),
-	    ok
+    if (LUser == error) or (LServer == error) ->
+	   {error, invalid_jid};
+       true ->
+	   F = fun () ->
+		       Password2 = case is_scrammed() and is_binary(Password)
+				       of
+				     true -> password_to_scram(Password);
+				     false -> Password
+				   end,
+		       mnesia:write(#passwd{us = US, password = Password2})
+	       end,
+	   {atomic, ok} = mnesia:transaction(F),
+	   ok
     end.
 
-%% @spec (User, Server, Password) -> {atomic, ok} | {atomic, exists} | {error, invalid_jid} | {aborted, Reason}
-try_register(User, Server, Password) ->
+try_register(User, Server, PasswordList) ->
     LUser = jlib:nodeprep(User),
     LServer = jlib:nameprep(Server),
+    Password = iolist_to_binary(PasswordList),
     US = {LUser, LServer},
-    if
-	(LUser == error) or (LServer == error) ->
-	    {error, invalid_jid};
-	true ->
-	    F = fun() ->
-			case mnesia:read({passwd, US}) of
-			    [] ->
-				Password2 = case is_scrammed() and is_list(Password) of
-						true -> password_to_scram(Password);
-						false -> Password
-					    end,
-				mnesia:write(#passwd{us = US,
-						     password = Password2}),
-				mnesia:dirty_update_counter(
-						    reg_users_counter,
-						    LServer, 1),
-				ok;
-			    [_E] ->
-				exists
-			end
-		end,
-	    mnesia:transaction(F)
+    if (LUser == error) or (LServer == error) ->
+	   {error, invalid_jid};
+       true ->
+	   F = fun () ->
+		       case mnesia:read({passwd, US}) of
+			 [] ->
+			     Password2 = case is_scrammed() and
+						is_binary(Password)
+					     of
+					   true -> password_to_scram(Password);
+					   false -> Password
+					 end,
+			     mnesia:write(#passwd{us = US,
+						  password = Password2}),
+			     mnesia:dirty_update_counter(reg_users_counter,
+							 LServer, 1),
+			     ok;
+			 [_E] -> exists
+		       end
+	       end,
+	   mnesia:transaction(F)
     end.
 
-%% Get all registered users in Mnesia
 dirty_get_registered_users() ->
     mnesia:dirty_all_keys(passwd).
 
 get_vh_registered_users(Server) ->
     LServer = jlib:nameprep(Server),
-    mnesia:dirty_select(
-      passwd,
-      [{#passwd{us = '$1', _ = '_'}, 
-	[{'==', {element, 2, '$1'}, LServer}], 
-	['$1']}]).
+    mnesia:dirty_select(passwd,
+			[{#passwd{us = '$1', _ = '_'},
+			  [{'==', {element, 2, '$1'}, LServer}], ['$1']}]).
 
-get_vh_registered_users(Server, [{from, Start}, {to, End}]) 
-	when is_integer(Start) and is_integer(End) ->
-    get_vh_registered_users(Server, [{limit, End-Start+1}, {offset, Start}]);
-
-get_vh_registered_users(Server, [{limit, Limit}, {offset, Offset}]) 
-	when is_integer(Limit) and is_integer(Offset) ->
+get_vh_registered_users(Server,
+			[{from, Start}, {to, End}])
+    when is_integer(Start) and is_integer(End) ->
+    get_vh_registered_users(Server,
+			    [{limit, End - Start + 1}, {offset, Start}]);
+get_vh_registered_users(Server,
+			[{limit, Limit}, {offset, Offset}])
+    when is_integer(Limit) and is_integer(Offset) ->
     case get_vh_registered_users(Server) of
-    [] ->
-	[];
-    Users ->
-	Set = lists:keysort(1, Users),
-	L = length(Set),
-	Start = if Offset < 1 -> 1;
-	           Offset > L -> L;
-	           true -> Offset
-	        end,
-	lists:sublist(Set, Start, Limit)
+      [] -> [];
+      Users ->
+	  Set = lists:keysort(1, Users),
+	  L = length(Set),
+	  Start = if Offset < 1 -> 1;
+		     Offset > L -> L;
+		     true -> Offset
+		  end,
+	  lists:sublist(Set, Start, Limit)
     end;
-
-get_vh_registered_users(Server, [{prefix, Prefix}]) 
-	when is_list(Prefix) ->
-    Set = [{U,S} || {U, S} <- get_vh_registered_users(Server), lists:prefix(Prefix, U)],
+get_vh_registered_users(Server, [{prefix, Prefix}])
+    when is_binary(Prefix) ->
+    Set = [{U, S}
+	   || {U, S} <- get_vh_registered_users(Server),
+	      str:prefix(Prefix, U)],
     lists:keysort(1, Set);
-
-get_vh_registered_users(Server, [{prefix, Prefix}, {from, Start}, {to, End}]) 
-	when is_list(Prefix) and is_integer(Start) and is_integer(End) ->
-    get_vh_registered_users(Server, [{prefix, Prefix}, {limit, End-Start+1}, {offset, Start}]);
-
-get_vh_registered_users(Server, [{prefix, Prefix}, {limit, Limit}, {offset, Offset}]) 
-	when is_list(Prefix) and is_integer(Limit) and is_integer(Offset) ->
-    case [{U,S} || {U, S} <- get_vh_registered_users(Server), lists:prefix(Prefix, U)] of
-    [] ->
-	[];
-    Users ->
-	Set = lists:keysort(1, Users),
-	L = length(Set),
-	Start = if Offset < 1 -> 1;
-	           Offset > L -> L;
-	           true -> Offset
-	        end,
-	lists:sublist(Set, Start, Limit)
+get_vh_registered_users(Server,
+			[{prefix, Prefix}, {from, Start}, {to, End}])
+    when is_binary(Prefix) and is_integer(Start) and
+	   is_integer(End) ->
+    get_vh_registered_users(Server,
+			    [{prefix, Prefix}, {limit, End - Start + 1},
+			     {offset, Start}]);
+get_vh_registered_users(Server,
+			[{prefix, Prefix}, {limit, Limit}, {offset, Offset}])
+    when is_binary(Prefix) and is_integer(Limit) and
+	   is_integer(Offset) ->
+    case [{U, S}
+	  || {U, S} <- get_vh_registered_users(Server),
+	     str:prefix(Prefix, U)]
+	of
+      [] -> [];
+      Users ->
+	  Set = lists:keysort(1, Users),
+	  L = length(Set),
+	  Start = if Offset < 1 -> 1;
+		     Offset > L -> L;
+		     true -> Offset
+		  end,
+	  lists:sublist(Set, Start, Limit)
     end;
-
 get_vh_registered_users(Server, _) ->
     get_vh_registered_users(Server).
 
 get_vh_registered_users_number(Server) ->
     LServer = jlib:nameprep(Server),
-    Query = mnesia:dirty_select(
-		reg_users_counter,
-		[{#reg_users_counter{vhost = LServer, count = '$1'},
-		  [],
-		  ['$1']}]),
+    Query = mnesia:dirty_select(reg_users_counter,
+				[{#reg_users_counter{vhost = LServer,
+						     count = '$1'},
+				  [], ['$1']}]),
     case Query of
-	[Count] ->
-	    Count;
-	_ -> 0
+      [Count] -> Count;
+      _ -> 0
     end.
 
-get_vh_registered_users_number(Server, [{prefix, Prefix}]) when is_list(Prefix) ->
-    Set = [{U, S} || {U, S} <- get_vh_registered_users(Server), lists:prefix(Prefix, U)],
+get_vh_registered_users_number(Server,
+			       [{prefix, Prefix}])
+    when is_binary(Prefix) ->
+    Set = [{U, S}
+	   || {U, S} <- get_vh_registered_users(Server),
+	      str:prefix(Prefix, U)],
     length(Set);
-    
 get_vh_registered_users_number(Server, _) ->
     get_vh_registered_users_number(Server).
 
@@ -271,15 +261,16 @@ get_password(User, Server) ->
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
     case catch mnesia:dirty_read(passwd, US) of
-	[#passwd{password = Password}] when is_list(Password) ->
-	    Password;
-	[#passwd{password = Scram}] when is_record(Scram, scram) ->
-	    {base64:decode(Scram#scram.storedkey),
-	     base64:decode(Scram#scram.serverkey),
-	     base64:decode(Scram#scram.salt),
-	     Scram#scram.iterationcount};
-	_ ->
-	    false
+      [#passwd{password = Password}]
+	  when is_binary(Password) ->
+	  Password;
+      [#passwd{password = Scram}]
+	  when is_record(Scram, scram) ->
+	  {jlib:decode_base64(Scram#scram.storedkey),
+	   jlib:decode_base64(Scram#scram.serverkey),
+	   jlib:decode_base64(Scram#scram.salt),
+	   Scram#scram.iterationcount};
+      _ -> false
     end.
 
 get_password_s(User, Server) ->
@@ -287,162 +278,143 @@ get_password_s(User, Server) ->
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
     case catch mnesia:dirty_read(passwd, US) of
-	[#passwd{password = Password}] when is_list(Password) ->
-	    Password;
-	[#passwd{password = Scram}] when is_record(Scram, scram) ->
-	    [];
-	_ ->
-	    []
+      [#passwd{password = Password}]
+	  when is_binary(Password) ->
+	  Password;
+      [#passwd{password = Scram}]
+	  when is_record(Scram, scram) ->
+	  <<"">>;
+      _ -> <<"">>
     end.
 
-%% @spec (User, Server) -> true | false | {error, Error}
 is_user_exists(User, Server) ->
     LUser = jlib:nodeprep(User),
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
     case catch mnesia:dirty_read({passwd, US}) of
-	[] ->
-	    false;
-	[_] ->
-	    true;
-	Other ->
-	    {error, Other}
+      [] -> false;
+      [_] -> true;
+      Other -> {error, Other}
     end.
 
-%% @spec (User, Server) -> ok
-%% @doc Remove user.
-%% Note: it returns ok even if there was some problem removing the user.
 remove_user(User, Server) ->
     LUser = jlib:nodeprep(User),
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
-    F = fun() ->
+    F = fun () ->
 		mnesia:delete({passwd, US}),
-		mnesia:dirty_update_counter(reg_users_counter,
-					    LServer, -1)
-        end,
+		mnesia:dirty_update_counter(reg_users_counter, LServer,
+					    -1)
+	end,
     mnesia:transaction(F),
-	ok.
+    ok.
 
-%% @spec (User, Server, Password) -> ok | not_exists | not_allowed | bad_request
-%% @doc Remove user if the provided password is correct.
 remove_user(User, Server, Password) ->
     LUser = jlib:nodeprep(User),
     LServer = jlib:nameprep(Server),
     US = {LUser, LServer},
-    F = fun() ->
+    F = fun () ->
 		case mnesia:read({passwd, US}) of
-		    [#passwd{password = Password}] when is_list(Password) ->
-			mnesia:delete({passwd, US}),
-			mnesia:dirty_update_counter(reg_users_counter,
-						    LServer, -1),
-			ok;
-		    [#passwd{password = Scram}] when is_record(Scram, scram) ->
-			case is_password_scram_valid(Password, Scram) of
-			    true ->
-				mnesia:delete({passwd, US}),
-				mnesia:dirty_update_counter(reg_users_counter,
-							    LServer, -1),
-				ok;
-			    false ->
-				not_allowed
-			end;
-		    _ ->
-			not_exists
+		  [#passwd{password = Password}]
+		      when is_binary(Password) ->
+		      mnesia:delete({passwd, US}),
+		      mnesia:dirty_update_counter(reg_users_counter, LServer,
+						  -1),
+		      ok;
+		  [#passwd{password = Scram}]
+		      when is_record(Scram, scram) ->
+		      case is_password_scram_valid(Password, Scram) of
+			true ->
+			    mnesia:delete({passwd, US}),
+			    mnesia:dirty_update_counter(reg_users_counter,
+							LServer, -1),
+			    ok;
+			false -> not_allowed
+		      end;
+		  _ -> not_exists
 		end
-        end,
+	end,
     case mnesia:transaction(F) of
-	{atomic, ok} ->
-	    ok;
-	{atomic, Res} ->
-	    Res;
-	_ ->
-	    bad_request
+      {atomic, ok} -> ok;
+      {atomic, Res} -> Res;
+      _ -> bad_request
     end.
 
 update_table() ->
     Fields = record_info(fields, passwd),
     case mnesia:table_info(passwd, attributes) of
-	Fields ->
-	    maybe_scram_passwords(),
-	    ok;
-	[user, password] ->
-	    ?INFO_MSG("Converting passwd table from "
-		      "{user, password} format", []),
-	    Host = ?MYNAME,
-	    {atomic, ok} = mnesia:create_table(
-			     ejabberd_auth_internal_tmp_table,
-			     [{disc_only_copies, [node()]},
-			      {type, bag},
-			      {local_content, true},
-			      {record_name, passwd},
-			      {attributes, record_info(fields, passwd)}]),
-	    mnesia:transform_table(passwd, ignore, Fields),
-	    F1 = fun() ->
-			 mnesia:write_lock_table(ejabberd_auth_internal_tmp_table),
-			 mnesia:foldl(
-			   fun(#passwd{us = U} = R, _) ->
-				   mnesia:dirty_write(
-				     ejabberd_auth_internal_tmp_table,
-				     R#passwd{us = {U, Host}})
-			   end, ok, passwd)
-		 end,
-	    mnesia:transaction(F1),
-	    mnesia:clear_table(passwd),
-	    F2 = fun() ->
-			 mnesia:write_lock_table(passwd),
-			 mnesia:foldl(
-			   fun(R, _) ->
-				   mnesia:dirty_write(R)
-			   end, ok, ejabberd_auth_internal_tmp_table)
-		 end,
-	    mnesia:transaction(F2),
-	    mnesia:delete_table(ejabberd_auth_internal_tmp_table);
-	_ ->
-	    ?INFO_MSG("Recreating passwd table", []),
-	    mnesia:transform_table(passwd, ignore, Fields)
+        Fields ->
+            convert_to_binary(Fields),
+            maybe_scram_passwords(),
+            ok;
+        _ ->
+            ?INFO_MSG("Recreating passwd table", []),
+            mnesia:transform_table(passwd, ignore, Fields)
     end.
 
+convert_to_binary(Fields) ->
+    ejabberd_config:convert_table_to_binary(
+      passwd, Fields, set,
+      fun(#passwd{us = {U, _}}) -> U end,
+      fun(#passwd{us = {U, S}, password = Pass} = R) ->
+              NewUS = {iolist_to_binary(U), iolist_to_binary(S)},
+              NewPass = case Pass of
+                            #scram{storedkey = StoredKey,
+                                   serverkey = ServerKey,
+                                   salt = Salt} ->
+                                Pass#scram{
+                                  storedkey = iolist_to_binary(StoredKey),
+                                  serverkey = iolist_to_binary(ServerKey),
+                                  salt = iolist_to_binary(Salt)};
+                            _ ->
+                                iolist_to_binary(Pass)
+                        end,
+              R#passwd{us = NewUS, password = NewPass}
+      end).
+
 %%%
 %%% SCRAM
 %%%
 
-%% The passwords are stored scrammed in the table either if the option says so,
-%% or if at least the first password is scrammed.
 is_scrammed() ->
     OptionScram = is_option_scram(),
-    FirstElement = mnesia:dirty_read(passwd, mnesia:dirty_first(passwd)),
+    FirstElement = mnesia:dirty_read(passwd,
+				     mnesia:dirty_first(passwd)),
     case {OptionScram, FirstElement} of
-	{true, _} ->
-	    true;
-	{false, [#passwd{password = Scram}]} when is_record(Scram, scram) ->
-	    true;
-	_ ->
-	    false
+      {true, _} -> true;
+      {false, [#passwd{password = Scram}]}
+	  when is_record(Scram, scram) ->
+	  true;
+      _ -> false
     end.
 
 is_option_scram() ->
-    scram == ejabberd_config:get_local_option({auth_password_format, ?MYNAME}).
+    scram ==
+      ejabberd_config:get_local_option({auth_password_format, ?MYNAME},
+                                       fun(V) -> V end).
 
 maybe_alert_password_scrammed_without_option() ->
     case is_scrammed() andalso not is_option_scram() of
-	true ->
-	    ?ERROR_MSG("Some passwords were stored in the database as SCRAM, "
-		       "but 'auth_password_format' is not configured 'scram'. "
-		       "The option will now be considered to be 'scram'.", []);
-	false ->
-	    ok
+      true ->
+	  ?ERROR_MSG("Some passwords were stored in the database "
+		     "as SCRAM, but 'auth_password_format' "
+		     "is not configured 'scram'. The option "
+		     "will now be considered to be 'scram'.",
+		     []);
+      false -> ok
     end.
 
 maybe_scram_passwords() ->
     case is_scrammed() of
-	true -> scram_passwords();
-	false -> ok
+      true -> scram_passwords();
+      false -> ok
     end.
 
 scram_passwords() ->
-    ?INFO_MSG("Converting the stored passwords into SCRAM bits", []),
-    Fun = fun(#passwd{password = Password} = P) ->
+    ?INFO_MSG("Converting the stored passwords into "
+	      "SCRAM bits",
+	      []),
+    Fun = fun (#passwd{password = Password} = P) ->
 		  Scram = password_to_scram(Password),
 		  P#passwd{password = Scram}
 	  end,
@@ -450,21 +422,39 @@ scram_passwords() ->
     mnesia:transform_table(passwd, Fun, Fields).
 
 password_to_scram(Password) ->
-    password_to_scram(Password, ?SCRAM_DEFAULT_ITERATION_COUNT).
+    password_to_scram(Password,
+		      ?SCRAM_DEFAULT_ITERATION_COUNT).
 
 password_to_scram(Password, IterationCount) ->
     Salt = crypto:rand_bytes(?SALT_LENGTH),
-    SaltedPassword = scram:salted_password(Password, Salt, IterationCount),
-    StoredKey = scram:stored_key(scram:client_key(SaltedPassword)),
+    SaltedPassword = scram:salted_password(Password, Salt,
+					   IterationCount),
+    StoredKey =
+	scram:stored_key(scram:client_key(SaltedPassword)),
     ServerKey = scram:server_key(SaltedPassword),
-    #scram{storedkey = base64:encode(StoredKey),
-	   serverkey = base64:encode(ServerKey),
-	   salt = base64:encode(Salt),
+    #scram{storedkey = jlib:encode_base64(StoredKey),
+	   serverkey = jlib:encode_base64(ServerKey),
+	   salt = jlib:encode_base64(Salt),
 	   iterationcount = IterationCount}.
 
 is_password_scram_valid(Password, Scram) ->
     IterationCount = Scram#scram.iterationcount,
-    Salt = base64:decode(Scram#scram.salt),
-    SaltedPassword = scram:salted_password(Password, Salt, IterationCount),
-    StoredKey = scram:stored_key(scram:client_key(SaltedPassword)),
-    (base64:decode(Scram#scram.storedkey) == StoredKey).
+    Salt = jlib:decode_base64(Scram#scram.salt),
+    SaltedPassword = scram:salted_password(Password, Salt,
+					   IterationCount),
+    StoredKey =
+	scram:stored_key(scram:client_key(SaltedPassword)),
+    jlib:decode_base64(Scram#scram.storedkey) == StoredKey.
+
+export(_Server) ->
+    [{passwd,
+      fun(Host, #passwd{us = {LUser, LServer}, password = Password})
+            when LServer == Host ->
+              Username = ejabberd_odbc:escape(LUser),
+              Pass = ejabberd_odbc:escape(Password),
+              [[<<"delete from users where username='">>, Username, <<"';">>],
+               [<<"insert into users(username, password) "
+                  "values ('">>, Username, <<"', '">>, Pass, <<"');">>]];
+         (_Host, _R) ->
+              []
+      end}].

src/ejabberd_auth_ldap.erl

@@ -5,7 +5,7 @@
 %%% Created : 12 Dec 2004 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,73 +25,57 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_auth_ldap).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
+-behaviour(ejabberd_auth).
 
 %% gen_server callbacks
--export([init/1,
-	 handle_info/2,
-	 handle_call/3,
-	 handle_cast/2,
-	 terminate/2,
-	 code_change/3
-	]).
+-export([init/1, handle_info/2, handle_call/3,
+	 handle_cast/2, terminate/2, code_change/3]).
 
 %% External exports
--export([start/1,
-	 stop/1,
-	 start_link/1,
-	 set_password/3,
-	 check_password/3,
-	 check_password/5,
-	 try_register/3,
-	 dirty_get_registered_users/0,
-	 get_vh_registered_users/1,
-	 get_vh_registered_users_number/1,
-	 get_password/2,
-	 get_password_s/2,
-	 is_user_exists/2,
-	 remove_user/2,
-	 remove_user/3,
-	 store_type/0,
-	 plain_password_required/0
-	]).
+-export([start/1, stop/1, start_link/1, set_password/3,
+	 check_password/3, check_password/5, try_register/3,
+	 dirty_get_registered_users/0, get_vh_registered_users/1,
+         get_vh_registered_users/2,
+         get_vh_registered_users_number/1,
+	 get_vh_registered_users_number/2, get_password/2,
+	 get_password_s/2, is_user_exists/2, remove_user/2,
+	 remove_user/3, store_type/0,
+	 plain_password_required/0]).
 
 -include("ejabberd.hrl").
+
 -include("eldap/eldap.hrl").
 
--record(state, {host,
-		eldap_id,
-		bind_eldap_id,
-		servers,
-		backups,
-		port,
-		tls_options,
-		dn,
-		password,
-		base,
-		uids,
-		ufilter,
-		sfilter,
-		lfilter, %% Local filter (performed by ejabberd, not LDAP)
-                deref_aliases,
-		dn_filter,
-		dn_filter_attrs
-	       }).
+-record(state,
+	{host = <<"">>          :: binary(),
+         eldap_id = <<"">>      :: binary(),
+         bind_eldap_id = <<"">> :: binary(),
+         servers = []           :: [binary()],
+         backups = []           :: [binary()],
+         port = ?LDAP_PORT      :: inet:port_number(),
+	 tls_options = []       :: list(),
+         dn = <<"">>            :: binary(),
+         password = <<"">>      :: binary(),
+         base = <<"">>          :: binary(),
+         uids = []              :: [{binary()} | {binary(), binary()}],
+         ufilter = <<"">>       :: binary(),
+         sfilter = <<"">>       :: binary(),
+	 lfilter                :: {any(), any()},
+         deref_aliases = never  :: never | searching | finding | always,
+         dn_filter              :: binary(),
+         dn_filter_attrs = []   :: [binary()]}).
 
-%% Unused callbacks.
-handle_cast(_Request, State) ->
-    {noreply, State}.
-code_change(_OldVsn, State, _Extra) ->
-    {ok, State}.
-handle_info(_Info, State) ->
-    {noreply, State}.
-%% -----
+handle_cast(_Request, State) -> {noreply, State}.
 
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
 
--define(LDAP_SEARCH_TIMEOUT, 5). % Timeout for LDAP search queries in seconds
+handle_info(_Info, State) -> {noreply, State}.
 
+-define(LDAP_SEARCH_TIMEOUT, 5).
 
 %%%----------------------------------------------------------------------
 %%% API
@@ -99,10 +83,8 @@ handle_info(_Info, State) ->
 
 start(Host) ->
     Proc = gen_mod:get_module_proc(Host, ?MODULE),
-    ChildSpec = {
-      Proc, {?MODULE, start_link, [Host]},
-      transient, 1000, worker, [?MODULE]
-     },
+    ChildSpec = {Proc, {?MODULE, start_link, [Host]},
+		 transient, 1000, worker, [?MODULE]},
     supervisor:start_child(ejabberd_sup, ChildSpec).
 
 stop(Host) ->
@@ -115,113 +97,98 @@ start_link(Host) ->
     Proc = gen_mod:get_module_proc(Host, ?MODULE),
     gen_server:start_link({local, Proc}, ?MODULE, Host, []).
 
-terminate(_Reason, _State) ->
-    ok.
+terminate(_Reason, _State) -> ok.
 
 init(Host) ->
     State = parse_options(Host),
     eldap_pool:start_link(State#state.eldap_id,
-			  State#state.servers,
-			  State#state.backups,
-			  State#state.port,
-			  State#state.dn,
-			  State#state.password,
-			  State#state.tls_options),
+			  State#state.servers, State#state.backups,
+			  State#state.port, State#state.dn,
+			  State#state.password, State#state.tls_options),
     eldap_pool:start_link(State#state.bind_eldap_id,
-			  State#state.servers,
-			  State#state.backups,
-			  State#state.port,
-			  State#state.dn,
-			  State#state.password,
-			  State#state.tls_options),
+			  State#state.servers, State#state.backups,
+			  State#state.port, State#state.dn,
+			  State#state.password, State#state.tls_options),
     {ok, State}.
 
-plain_password_required() ->
-    true.
+plain_password_required() -> true.
 
-store_type() ->
-	external.
+store_type() -> external.
 
 check_password(User, Server, Password) ->
-    %% In LDAP spec: empty password means anonymous authentication.
-    %% As ejabberd is providing other anonymous authentication mechanisms
-    %% we simply prevent the use of LDAP anonymous authentication.
-    if Password == "" ->
-        false;
-    true ->
-        case catch check_password_ldap(User, Server, Password) of
-	        {'EXIT', _} -> false;
-	        Result -> Result
-        end
+    if Password == <<"">> -> false;
+       true ->
+	   case catch check_password_ldap(User, Server, Password)
+	       of
+	     {'EXIT', _} -> false;
+	     Result -> Result
+	   end
     end.
 
-check_password(User, Server, Password, _Digest, _DigestGen) ->
+check_password(User, Server, Password, _Digest,
+	       _DigestGen) ->
     check_password(User, Server, Password).
 
 set_password(User, Server, Password) ->
     {ok, State} = eldap_utils:get_state(Server, ?MODULE),
     case find_user_dn(User, State) of
-	false ->
-	    {error, user_not_found};
-	DN ->
-	    eldap_pool:modify_passwd(State#state.eldap_id, DN, Password)
+      false -> {error, user_not_found};
+      DN ->
+	  eldap_pool:modify_passwd(State#state.eldap_id, DN,
+				   Password)
     end.
 
-%% @spec (User, Server, Password) -> {error, not_allowed}
 try_register(_User, _Server, _Password) ->
     {error, not_allowed}.
 
 dirty_get_registered_users() ->
     Servers = ejabberd_config:get_vh_by_auth_method(ldap),
-    lists:flatmap(
-      fun(Server) ->
-	      get_vh_registered_users(Server)
-      end, Servers).
+    lists:flatmap(fun (Server) ->
+			  get_vh_registered_users(Server)
+		  end,
+		  Servers).
 
 get_vh_registered_users(Server) ->
     case catch get_vh_registered_users_ldap(Server) of
-	{'EXIT', _} -> [];
-	Result -> Result
-	end.
+      {'EXIT', _} -> [];
+      Result -> Result
+    end.
+
+get_vh_registered_users(Server, _) ->
+    get_vh_registered_users(Server).
 
 get_vh_registered_users_number(Server) ->
     length(get_vh_registered_users(Server)).
 
-get_password(_User, _Server) ->
-    false.
+get_vh_registered_users_number(Server, _) ->
+    get_vh_registered_users_number(Server).
 
-get_password_s(_User, _Server) ->
-    "".
+get_password(_User, _Server) -> false.
+
+get_password_s(_User, _Server) -> <<"">>.
 
-%% @spec (User, Server) -> true | false | {error, Error}
 is_user_exists(User, Server) ->
     case catch is_user_exists_ldap(User, Server) of
-	{'EXIT', Error} ->
-	    {error, Error};
-	Result ->
-	    Result
+      {'EXIT', Error} -> {error, Error};
+      Result -> Result
     end.
 
-remove_user(_User, _Server) ->
-    {error, not_allowed}.
+remove_user(_User, _Server) -> {error, not_allowed}.
 
-remove_user(_User, _Server, _Password) ->
-    not_allowed.
+remove_user(_User, _Server, _Password) -> not_allowed.
 
-%%%----------------------------------------------------------------------
-%%% Internal functions
-%%%----------------------------------------------------------------------
 check_password_ldap(User, Server, Password) ->
-	{ok, State} = eldap_utils:get_state(Server, ?MODULE),
-	case find_user_dn(User, State) of
-	false ->
-	    false;
-	DN ->
-	    case eldap_pool:bind(State#state.bind_eldap_id, DN, Password) of
-		ok -> true;
-		_ -> false
-	    end
-	end.
+    {ok, State} = eldap_utils:get_state(Server, ?MODULE),
+    case find_user_dn(User, State) of
+      false -> false;
+      DN ->
+	  case eldap_pool:bind(State#state.bind_eldap_id, DN,
+			       Password)
+	      of
+	    ok -> true;
+	    _ -> false
+	  end
+    end.
 
 get_vh_registered_users_ldap(Server) ->
     {ok, State} = eldap_utils:get_state(Server, ?MODULE),
@@ -230,225 +197,206 @@ get_vh_registered_users_ldap(Server) ->
     Server = State#state.host,
     ResAttrs = result_attrs(State),
     case eldap_filter:parse(State#state.sfilter) of
-		{ok, EldapFilter} ->
-		    case eldap_pool:search(Eldap_ID,
-                                           [{base, State#state.base},
-                                            {filter, EldapFilter},
-                                            {timeout, ?LDAP_SEARCH_TIMEOUT},
-                                            {deref_aliases, State#state.deref_aliases},
-                                            {attributes, ResAttrs}]) of
-			#eldap_search_result{entries = Entries} ->
-			    lists:flatmap(
-			      fun(#eldap_entry{attributes = Attrs,
-					       object_name = DN}) ->
+      {ok, EldapFilter} ->
+	  case eldap_pool:search(Eldap_ID,
+				 [{base, State#state.base},
+				  {filter, EldapFilter},
+				  {timeout, ?LDAP_SEARCH_TIMEOUT},
+				  {deref_aliases, State#state.deref_aliases},
+				  {attributes, ResAttrs}])
+	      of
+	    #eldap_search_result{entries = Entries} ->
+		lists:flatmap(fun (#eldap_entry{attributes = Attrs,
+						object_name = DN}) ->
 				      case is_valid_dn(DN, Attrs, State) of
-					  false -> [];
-					  _ ->
-					      case eldap_utils:find_ldap_attrs(UIDs, Attrs) of
-						  "" -> [];
-						  {User, UIDFormat} ->
-						      case eldap_utils:get_user_part(User, UIDFormat) of
-							  {ok, U} ->
-							      case jlib:nodeprep(U) of
-								  error -> [];
-								  LU -> [{LU, jlib:nameprep(Server)}]
-							      end;
-							  _ -> []
-						      end
-					      end
+					false -> [];
+					_ ->
+					    case
+					      eldap_utils:find_ldap_attrs(UIDs,
+									  Attrs)
+						of
+					      <<"">> -> [];
+					      {User, UIDFormat} ->
+						  case
+						    eldap_utils:get_user_part(User,
+									      UIDFormat)
+						      of
+						    {ok, U} ->
+							case jlib:nodeprep(U) of
+							  error -> [];
+							  LU ->
+							      [{LU,
+								jlib:nameprep(Server)}]
+							end;
+						    _ -> []
+						  end
+					    end
 				      end
-			      end, Entries);
-			_ ->
-			    []
-		    end;
-		_ ->
-		    []
-	end.
+			      end,
+			      Entries);
+	    _ -> []
+	  end;
+      _ -> []
+    end.
 
 is_user_exists_ldap(User, Server) ->
     {ok, State} = eldap_utils:get_state(Server, ?MODULE),
     case find_user_dn(User, State) of
-		false -> false;
-		_DN -> true
-	end.
+      false -> false;
+      _DN -> true
+    end.
 
 handle_call(get_state, _From, State) ->
-	{reply, {ok, State}, State};
-
+    {reply, {ok, State}, State};
 handle_call(stop, _From, State) ->
     {stop, normal, ok, State};
-
 handle_call(_Request, _From, State) ->
     {reply, bad_request, State}.
 
 find_user_dn(User, State) ->
     ResAttrs = result_attrs(State),
-    case eldap_filter:parse(State#state.ufilter, [{"%u", User}]) of
-	{ok, Filter} ->
-	    case eldap_pool:search(State#state.eldap_id,
-				   [{base, State#state.base},
-				    {filter, Filter},
-                                    {deref_aliases, State#state.deref_aliases},
-				    {attributes, ResAttrs}]) of
-		#eldap_search_result{entries = [#eldap_entry{attributes = Attrs,
-							     object_name = DN} | _]} ->
-		    dn_filter(DN, Attrs, State);
-		_ ->
-		    false
-	    end;
-	_ ->
-	    false
+    case eldap_filter:parse(State#state.ufilter,
+			    [{<<"%u">>, User}])
+	of
+      {ok, Filter} ->
+	  case eldap_pool:search(State#state.eldap_id,
+				 [{base, State#state.base}, {filter, Filter},
+				  {deref_aliases, State#state.deref_aliases},
+				  {attributes, ResAttrs}])
+	      of
+	    #eldap_search_result{entries =
+				     [#eldap_entry{attributes = Attrs,
+						   object_name = DN}
+				      | _]} ->
+		dn_filter(DN, Attrs, State);
+	    _ -> false
+	  end;
+      _ -> false
     end.
 
-%% apply the dn filter and the local filter:
 dn_filter(DN, Attrs, State) ->
-    %% Check if user is denied access by attribute value (local check)
     case check_local_filter(Attrs, State) of
-        false -> false;
-        true -> is_valid_dn(DN, Attrs, State)
+      false -> false;
+      true -> is_valid_dn(DN, Attrs, State)
     end.
 
-%% Check that the DN is valid, based on the dn filter
-is_valid_dn(DN, _, #state{dn_filter = undefined}) ->
-    DN;
-
+is_valid_dn(DN, _, #state{dn_filter = undefined}) -> DN;
 is_valid_dn(DN, Attrs, State) ->
     DNAttrs = State#state.dn_filter_attrs,
     UIDs = State#state.uids,
-    Values = [{"%s", eldap_utils:get_ldap_attr(Attr, Attrs), 1} || Attr <- DNAttrs],
-    SubstValues = case eldap_utils:find_ldap_attrs(UIDs, Attrs) of
-		      "" -> Values;
-		      {S, UAF} ->
-			  case eldap_utils:get_user_part(S, UAF) of
-			      {ok, U} -> [{"%u", U} | Values];
-			      _ -> Values
-			  end
-		  end ++ [{"%d", State#state.host}, {"%D", DN}],
-    case eldap_filter:parse(State#state.dn_filter, SubstValues) of
-	{ok, EldapFilter} ->
-	    case eldap_pool:search(State#state.eldap_id,
-                                   [{base, State#state.base},
-                                    {filter, EldapFilter},
-                                    {deref_aliases, State#state.deref_aliases},
-                                    {attributes, ["dn"]}]) of
-		#eldap_search_result{entries = [_|_]} ->
-		    DN;
-		_ ->
-		    false
-	    end;
-	_ ->
-	    false
+    Values = [{<<"%s">>,
+	       eldap_utils:get_ldap_attr(Attr, Attrs), 1}
+	      || Attr <- DNAttrs],
+    SubstValues = case eldap_utils:find_ldap_attrs(UIDs,
+						   Attrs)
+		      of
+		    <<"">> -> Values;
+		    {S, UAF} ->
+			case eldap_utils:get_user_part(S, UAF) of
+			  {ok, U} -> [{<<"%u">>, U} | Values];
+			  _ -> Values
+			end
+		  end
+		    ++ [{<<"%d">>, State#state.host}, {<<"%D">>, DN}],
+    case eldap_filter:parse(State#state.dn_filter,
+			    SubstValues)
+	of
+      {ok, EldapFilter} ->
+	  case eldap_pool:search(State#state.eldap_id,
+				 [{base, State#state.base},
+				  {filter, EldapFilter},
+				  {deref_aliases, State#state.deref_aliases},
+				  {attributes, [<<"dn">>]}])
+	      of
+	    #eldap_search_result{entries = [_ | _]} -> DN;
+	    _ -> false
+	  end;
+      _ -> false
     end.
 
-%% The local filter is used to check an attribute in ejabberd
-%% and not in LDAP to limit the load on the LDAP directory.
-%% A local rule can be either:
-%%    {equal, {"accountStatus",["active"]}}
-%%    {notequal, {"accountStatus",["disabled"]}}
-%% {ldap_local_filter, {notequal, {"accountStatus",["disabled"]}}}
-check_local_filter(_Attrs, #state{lfilter = undefined}) ->
+check_local_filter(_Attrs,
+		   #state{lfilter = undefined}) ->
     true;
-check_local_filter(Attrs, #state{lfilter = LocalFilter}) ->
+check_local_filter(Attrs,
+		   #state{lfilter = LocalFilter}) ->
     {Operation, FilterMatch} = LocalFilter,
     local_filter(Operation, Attrs, FilterMatch).
-    
+
 local_filter(equal, Attrs, FilterMatch) ->
     {Attr, Value} = FilterMatch,
     case lists:keysearch(Attr, 1, Attrs) of
-        false -> false;
-        {value,{Attr,Value}} -> true;
-        _ -> false
+      false -> false;
+      {value, {Attr, Value}} -> true;
+      _ -> false
     end;
 local_filter(notequal, Attrs, FilterMatch) ->
     not local_filter(equal, Attrs, FilterMatch).
 
-result_attrs(#state{uids = UIDs, dn_filter_attrs = DNFilterAttrs}) ->
-    lists:foldl(
-      fun({UID}, Acc) ->
-	      [UID | Acc];
-	 ({UID, _}, Acc) ->
-	      [UID | Acc]
-      end, DNFilterAttrs, UIDs).
+result_attrs(#state{uids = UIDs,
+		    dn_filter_attrs = DNFilterAttrs}) ->
+    lists:foldl(fun ({UID}, Acc) -> [UID | Acc];
+		    ({UID, _}, Acc) -> [UID | Acc]
+		end,
+		DNFilterAttrs, UIDs).
 
-%%%----------------------------------------------------------------------
-%%% Auxiliary functions
-%%%----------------------------------------------------------------------
 parse_options(Host) ->
-    Eldap_ID = atom_to_list(gen_mod:get_module_proc(Host, ?MODULE)),
-    Bind_Eldap_ID = atom_to_list(gen_mod:get_module_proc(Host, bind_ejabberd_auth_ldap)),
-    LDAPServers = ejabberd_config:get_local_option({ldap_servers, Host}),
-    LDAPBackups = case ejabberd_config:get_local_option({ldap_backups, Host}) of
-		   undefined -> [];
-		   Backups -> Backups
-		   end,
-    LDAPEncrypt = ejabberd_config:get_local_option({ldap_encrypt, Host}),
-    LDAPTLSVerify = ejabberd_config:get_local_option({ldap_tls_verify, Host}),
-    LDAPTLSCAFile = ejabberd_config:get_local_option({ldap_tls_cacertfile, Host}),
-    LDAPTLSDepth = ejabberd_config:get_local_option({ldap_tls_depth, Host}),
-    LDAPPort = case ejabberd_config:get_local_option({ldap_port, Host}) of
-		   undefined -> case LDAPEncrypt of
-				    tls -> ?LDAPS_PORT;
-				    starttls -> ?LDAP_PORT;
-				    _ -> ?LDAP_PORT
-				end;
-		   P -> P
-	       end,
-    RootDN = case ejabberd_config:get_local_option({ldap_rootdn, Host}) of
-		 undefined -> "";
-		 RDN -> RDN
-	     end,
-    Password = case ejabberd_config:get_local_option({ldap_password, Host}) of
-		   undefined -> "";
-		   Pass -> Pass
-	       end,
-    UIDs = case ejabberd_config:get_local_option({ldap_uids, Host}) of
-	       undefined -> [{"uid", "%u"}];
-	       UI -> eldap_utils:uids_domain_subst(Host, UI)
-	   end,
-    SubFilter = lists:flatten(eldap_utils:generate_subfilter(UIDs)),
-    UserFilter = case ejabberd_config:get_local_option({ldap_filter, Host}) of
-		     undefined -> SubFilter;
-		     "" -> SubFilter;
-		     F ->
-                         eldap_utils:check_filter(F),
-                         "(&" ++ SubFilter ++ F ++ ")"
-		 end,
-    SearchFilter = eldap_filter:do_sub(UserFilter, [{"%u", "*"}]),
-    LDAPBase = ejabberd_config:get_local_option({ldap_base, Host}),
+    Cfg = eldap_utils:get_config(Host, []),
+    Eldap_ID = jlib:atom_to_binary(gen_mod:get_module_proc(Host, ?MODULE)),
+    Bind_Eldap_ID = jlib:atom_to_binary(
+                      gen_mod:get_module_proc(Host, bind_ejabberd_auth_ldap)),
+    UIDsTemp = eldap_utils:get_opt(
+                 {ldap_uids, Host}, [],
+                 fun(Us) ->
+                         lists:map(
+                           fun({U, P}) ->
+                                   {iolist_to_binary(U),
+                                    iolist_to_binary(P)};
+                              ({U}) ->
+                                   {iolist_to_binary(U)}
+                           end, Us)
+                 end, [{<<"uid">>, <<"%u">>}]),
+    UIDs = eldap_utils:uids_domain_subst(Host, UIDsTemp),
+    SubFilter =	eldap_utils:generate_subfilter(UIDs),
+    UserFilter = case eldap_utils:get_opt(
+                        {ldap_filter, Host}, [],
+                        fun check_filter/1, <<"">>) of
+                     <<"">> ->
+			 SubFilter;
+                     F ->
+                         <<"(&", SubFilter/binary, F/binary, ")">>
+                 end,
+    SearchFilter = eldap_filter:do_sub(UserFilter,
+				       [{<<"%u">>, <<"*">>}]),
     {DNFilter, DNFilterAttrs} =
-	case ejabberd_config:get_local_option({ldap_dn_filter, Host}) of
-	    undefined ->
-		{undefined, []};
-	    {DNF, undefined} ->
-		{DNF, []};
-	    {DNF, DNFA} ->
-		{DNF, DNFA}
-	end,
-    eldap_utils:check_filter(DNFilter),
-    LocalFilter = ejabberd_config:get_local_option({ldap_local_filter, Host}),
-    DerefAliases = case ejabberd_config:get_local_option(
-                          {ldap_deref_aliases, Host}) of
-                       undefined -> never;
-                       Val -> Val
-                   end,
-    #state{host = Host,
-	   eldap_id = Eldap_ID,
-	   bind_eldap_id = Bind_Eldap_ID,
-	   servers = LDAPServers,
-	   backups = LDAPBackups,
-	   port = LDAPPort,
-	   tls_options = [{encrypt, LDAPEncrypt},
-			  {tls_verify, LDAPTLSVerify},
-                          {tls_cacertfile, LDAPTLSCAFile},
-                          {tls_depth, LDAPTLSDepth}],
-	   dn = RootDN,
-	   password = Password,
-	   base = LDAPBase,
-	   uids = UIDs,
-	   ufilter = UserFilter,
-	   sfilter = SearchFilter,
-	   lfilter = LocalFilter,
-           deref_aliases = DerefAliases,
-	   dn_filter = DNFilter,
-	   dn_filter_attrs = DNFilterAttrs
-	  }.
+        eldap_utils:get_opt({ldap_dn_filter, Host}, [],
+                            fun({DNF, DNFA}) ->
+                                    NewDNFA = case DNFA of
+                                                  undefined ->
+                                                      [];
+                                                  _ ->
+                                                      [iolist_to_binary(A)
+                                                       || A <- DNFA]
+                                              end,
+                                    NewDNF = check_filter(DNF),
+                                    {NewDNF, NewDNFA}
+                            end, {undefined, []}),
+    LocalFilter = eldap_utils:get_opt(
+                    {ldap_local_filter, Host}, [], fun(V) -> V end),
+    #state{host = Host, eldap_id = Eldap_ID,
+           bind_eldap_id = Bind_Eldap_ID,
+           servers = Cfg#eldap_config.servers,
+	   backups = Cfg#eldap_config.backups,
+           port = Cfg#eldap_config.port,
+	   tls_options = Cfg#eldap_config.tls_options,
+	   dn = Cfg#eldap_config.dn,
+           password = Cfg#eldap_config.password,
+           base = Cfg#eldap_config.base,
+           deref_aliases = Cfg#eldap_config.deref_aliases,
+	   uids = UIDs, ufilter = UserFilter,
+	   sfilter = SearchFilter, lfilter = LocalFilter,
+	   dn_filter = DNFilter, dn_filter_attrs = DNFilterAttrs}.
+
+check_filter(F) ->
+    NewF = iolist_to_binary(F),
+    {ok, _} = eldap_filter:parse(NewF),
+    NewF.

src/ejabberd_auth_odbc.erl

@@ -5,7 +5,7 @@
 %%% Created : 12 Dec 2004 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,261 +25,218 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_auth_odbc).
+
 -author('alexey@process-one.net').
 
+-behaviour(ejabberd_auth).
+
 %% External exports
--export([start/1,
-	 set_password/3,
-	 check_password/3,
-	 check_password/5,
-	 try_register/3,
-	 dirty_get_registered_users/0,
-	 get_vh_registered_users/1,
+-export([start/1, set_password/3, check_password/3,
+	 check_password/5, try_register/3,
+	 dirty_get_registered_users/0, get_vh_registered_users/1,
 	 get_vh_registered_users/2,
 	 get_vh_registered_users_number/1,
-	 get_vh_registered_users_number/2,
-	 get_password/2,
-	 get_password_s/2,
-	 is_user_exists/2,
-	 remove_user/2,
-	 remove_user/3,
-	 store_type/0,
-	 plain_password_required/0
-	]).
+	 get_vh_registered_users_number/2, get_password/2,
+	 get_password_s/2, is_user_exists/2, remove_user/2,
+	 remove_user/3, store_type/0,
+	 plain_password_required/0]).
 
 -include("ejabberd.hrl").
 
-%%%----------------------------------------------------------------------
-%%% API
-%%%----------------------------------------------------------------------
-start(_Host) ->
-    ok.
+start(_Host) -> ok.
 
-plain_password_required() ->
-    false.
+plain_password_required() -> false.
 
-store_type() ->
-	plain.
+store_type() -> plain.
 
-%% @spec (User, Server, Password) -> true | false | {error, Error}
 check_password(User, Server, Password) ->
     case jlib:nodeprep(User) of
-	error ->
-	    false;
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    LServer = jlib:nameprep(Server),
-	    try odbc_queries:get_password(LServer, Username) of
-		{selected, ["password"], [{Password}]} ->
-		    Password /= ""; %% Password is correct, and not empty
-		{selected, ["password"], [{_Password2}]} ->
-		    false; %% Password is not correct
-		{selected, ["password"], []} ->
-		    false; %% Account does not exist
-		{error, _Error} ->
-		    false %% Typical error is that table doesn't exist
-	    catch
-		_:_ ->
-		    false %% Typical error is database not accessible
-	    end
+      error -> false;
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  LServer = jlib:nameprep(Server),
+	  try odbc_queries:get_password(LServer, Username) of
+	    {selected, [<<"password">>], [[Password]]} ->
+		Password /= <<"">>;
+	    {selected, [<<"password">>], [[_Password2]]} ->
+		false; %% Password is not correct
+	    {selected, [<<"password">>], []} ->
+		false; %% Account does not exist
+	    {error, _Error} ->
+		false %% Typical error is that table doesn't exist
+	  catch
+	    _:_ ->
+		false %% Typical error is database not accessible
+	  end
     end.
 
-%% @spec (User, Server, Password, Digest, DigestGen) -> true | false | {error, Error}
-check_password(User, Server, Password, Digest, DigestGen) ->
+check_password(User, Server, Password, Digest,
+	       DigestGen) ->
     case jlib:nodeprep(User) of
-	error ->
-	    false;
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    LServer = jlib:nameprep(Server),
-	    try odbc_queries:get_password(LServer, Username) of
-		%% Account exists, check if password is valid
-		{selected, ["password"], [{Passwd}]} ->
-		    DigRes = if
-				 Digest /= "" ->
-				     Digest == DigestGen(Passwd);
-				 true ->
-				     false
-			     end,
-		    if DigRes ->
-			    true;
-		       true ->
-			    (Passwd == Password) and (Password /= "")
-		    end;
-		{selected, ["password"], []} ->
-		    false; %% Account does not exist
-		{error, _Error} ->
-		    false %% Typical error is that table doesn't exist
-	    catch
-		_:_ ->
-		    false %% Typical error is database not accessible
-	    end
+      error -> false;
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  LServer = jlib:nameprep(Server),
+	  try odbc_queries:get_password(LServer, Username) of
+	    %% Account exists, check if password is valid
+	    {selected, [<<"password">>], [[Passwd]]} ->
+		DigRes = if Digest /= <<"">> ->
+				Digest == DigestGen(Passwd);
+			    true -> false
+			 end,
+		if DigRes -> true;
+		   true -> (Passwd == Password) and (Password /= <<"">>)
+		end;
+	    {selected, [<<"password">>], []} ->
+		false; %% Account does not exist
+	    {error, _Error} ->
+		false %% Typical error is that table doesn't exist
+	  catch
+	    _:_ ->
+		false %% Typical error is database not accessible
+	  end
     end.
 
-%% @spec (User::string(), Server::string(), Password::string()) ->
-%%       ok | {error, invalid_jid}
 set_password(User, Server, Password) ->
     case jlib:nodeprep(User) of
-	error ->
-	    {error, invalid_jid};
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    Pass = ejabberd_odbc:escape(Password),
-	    LServer = jlib:nameprep(Server),
-	    case catch odbc_queries:set_password_t(LServer, Username, Pass) of
-	        {atomic, ok} -> ok;
-	        Other -> {error, Other}
-	    end
+      error -> {error, invalid_jid};
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  Pass = ejabberd_odbc:escape(Password),
+	  LServer = jlib:nameprep(Server),
+	  case catch odbc_queries:set_password_t(LServer,
+						 Username, Pass)
+	      of
+	    {atomic, ok} -> ok;
+	    Other -> {error, Other}
+	  end
     end.
 
-
-%% @spec (User, Server, Password) -> {atomic, ok} | {atomic, exists} | {error, invalid_jid}
 try_register(User, Server, Password) ->
     case jlib:nodeprep(User) of
-	error ->
-	    {error, invalid_jid};
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    Pass = ejabberd_odbc:escape(Password),
-	    LServer = jlib:nameprep(Server),
-	    case catch odbc_queries:add_user(LServer, Username, Pass) of
-		{updated, 1} ->
-		    {atomic, ok};
-		_ ->
-		    {atomic, exists}
-	    end
+      error -> {error, invalid_jid};
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  Pass = ejabberd_odbc:escape(Password),
+	  LServer = jlib:nameprep(Server),
+	  case catch odbc_queries:add_user(LServer, Username,
+					   Pass)
+	      of
+	    {updated, 1} -> {atomic, ok};
+	    _ -> {atomic, exists}
+	  end
     end.
 
 dirty_get_registered_users() ->
     Servers = ejabberd_config:get_vh_by_auth_method(odbc),
-    lists:flatmap(
-      fun(Server) ->
-	      get_vh_registered_users(Server)
-      end, Servers).
+    lists:flatmap(fun (Server) ->
+			  get_vh_registered_users(Server)
+		  end,
+		  Servers).
 
 get_vh_registered_users(Server) ->
     LServer = jlib:nameprep(Server),
     case catch odbc_queries:list_users(LServer) of
-	{selected, ["username"], Res} ->
-	    [{U, LServer} || {U} <- Res];
-	_ ->
-	    []
+      {selected, [<<"username">>], Res} ->
+	  [{U, LServer} || [U] <- Res];
+      _ -> []
     end.
 
 get_vh_registered_users(Server, Opts) ->
     LServer = jlib:nameprep(Server),
     case catch odbc_queries:list_users(LServer, Opts) of
-	{selected, ["username"], Res} ->
-	    [{U, LServer} || {U} <- Res];
-	_ ->
-	    []
+      {selected, [<<"username">>], Res} ->
+	  [{U, LServer} || [U] <- Res];
+      _ -> []
     end.
 
 get_vh_registered_users_number(Server) ->
     LServer = jlib:nameprep(Server),
     case catch odbc_queries:users_number(LServer) of
-	{selected, [_], [{Res}]} ->
-	    list_to_integer(Res);
-	_ ->
-	    0
+      {selected, [_], [[Res]]} ->
+	  jlib:binary_to_integer(Res);
+      _ -> 0
     end.
 
 get_vh_registered_users_number(Server, Opts) ->
     LServer = jlib:nameprep(Server),
     case catch odbc_queries:users_number(LServer, Opts) of
-	{selected, [_], [{Res}]} ->
-	    list_to_integer(Res);
-	_Other ->
-	    0
+      {selected, [_], [[Res]]} ->
+	  jlib:binary_to_integer(Res);
+      _Other -> 0
     end.
 
 get_password(User, Server) ->
     case jlib:nodeprep(User) of
-	error ->
-	    false;
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    LServer = jlib:nameprep(Server),
-	    case catch odbc_queries:get_password(LServer, Username) of
-		{selected, ["password"], [{Password}]} ->
-		    Password;
-		_ ->
-		    false
-	    end
+      error -> false;
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  LServer = jlib:nameprep(Server),
+	  case catch odbc_queries:get_password(LServer, Username)
+	      of
+	    {selected, [<<"password">>], [[Password]]} -> Password;
+	    _ -> false
+	  end
     end.
 
 get_password_s(User, Server) ->
     case jlib:nodeprep(User) of
-	error ->
-	    "";
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    LServer = jlib:nameprep(Server),
-	    case catch odbc_queries:get_password(LServer, Username) of
-		{selected, ["password"], [{Password}]} ->
-		    Password;
-		_ ->
-		    ""
-	    end
+      error -> <<"">>;
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  LServer = jlib:nameprep(Server),
+	  case catch odbc_queries:get_password(LServer, Username)
+	      of
+	    {selected, [<<"password">>], [[Password]]} -> Password;
+	    _ -> <<"">>
+	  end
     end.
 
-%% @spec (User, Server) -> true | false | {error, Error}
 is_user_exists(User, Server) ->
     case jlib:nodeprep(User) of
-	error ->
-	    false;
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    LServer = jlib:nameprep(Server),
-	    try odbc_queries:get_password(LServer, Username) of
-		{selected, ["password"], [{_Password}]} ->
-		    true; %% Account exists
-		{selected, ["password"], []} ->
-		    false; %% Account does not exist
-		{error, Error} ->
-		    {error, Error} %% Typical error is that table doesn't exist
-	    catch
-		_:B ->
-		    {error, B} %% Typical error is database not accessible
-	    end
+      error -> false;
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  LServer = jlib:nameprep(Server),
+	  try odbc_queries:get_password(LServer, Username) of
+	    {selected, [<<"password">>], [[_Password]]} ->
+		true; %% Account exists
+	    {selected, [<<"password">>], []} ->
+		false; %% Account does not exist
+	    {error, Error} -> {error, Error}
+	  catch
+	    _:B -> {error, B}
+	  end
     end.
 
-%% @spec (User, Server) -> ok | error
-%% @doc Remove user.
-%% Note: it may return ok even if there was some problem removing the user.
 remove_user(User, Server) ->
     case jlib:nodeprep(User) of
-	error ->
-	    error;
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    LServer = jlib:nameprep(Server),
-	    catch odbc_queries:del_user(LServer, Username),
-		ok
+      error -> error;
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  LServer = jlib:nameprep(Server),
+	  catch odbc_queries:del_user(LServer, Username),
+	  ok
     end.
 
-%% @spec (User, Server, Password) -> ok | error | not_exists | not_allowed
-%% @doc Remove user if the provided password is correct.
 remove_user(User, Server, Password) ->
     case jlib:nodeprep(User) of
-	error ->
-	    error;
-	LUser ->
-	    Username = ejabberd_odbc:escape(LUser),
-	    Pass = ejabberd_odbc:escape(Password),
-	    LServer = jlib:nameprep(Server),
-	    F = fun() ->
-			Result = odbc_queries:del_user_return_password(
-				   LServer, Username, Pass),
-			case Result of
-			    {selected, ["password"], [{Password}]} ->
-				ok;
-			    {selected, ["password"], []} ->
-				not_exists;
-			    _ ->
-				not_allowed
-			end
-		end,
-	    {atomic, Result} = odbc_queries:sql_transaction(LServer, F),
-	    Result
+      error -> error;
+      LUser ->
+	  Username = ejabberd_odbc:escape(LUser),
+	  Pass = ejabberd_odbc:escape(Password),
+	  LServer = jlib:nameprep(Server),
+	  F = fun () ->
+		      Result = odbc_queries:del_user_return_password(LServer,
+								     Username,
+								     Pass),
+		      case Result of
+			{selected, [<<"password">>], [[Password]]} -> ok;
+			{selected, [<<"password">>], []} -> not_exists;
+			_ -> not_allowed
+		      end
+	      end,
+	  {atomic, Result} = odbc_queries:sql_transaction(LServer,
+							  F),
+	  Result
     end.

src/ejabberd_auth_pam.erl

@@ -5,7 +5,7 @@
 %%% Created : 5 Jul 2007 by Evgeniy Khramtsov <xram@jabber.ru>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -24,102 +24,94 @@
 %%%
 %%%-------------------------------------------------------------------
 -module(ejabberd_auth_pam).
+
 -author('xram@jabber.ru').
 
-%% External exports
--export([start/1,
-	 set_password/3,
-	 check_password/3,
-	 check_password/5,
-	 try_register/3,
-	 dirty_get_registered_users/0,
-	 get_vh_registered_users/1,
-	 get_password/2,
-	 get_password_s/2,
-	 is_user_exists/2,
-	 remove_user/2,
-	 remove_user/3,
-	 store_type/0,
-	 plain_password_required/0
-	]).
+-behaviour(ejabberd_auth).
+
+%% External exports
+-export([start/1, set_password/3, check_password/3,
+	 check_password/5, try_register/3,
+	 dirty_get_registered_users/0, get_vh_registered_users/1,
+         get_vh_registered_users/2, get_vh_registered_users_number/1,
+         get_vh_registered_users_number/2,
+	 get_password/2, get_password_s/2, is_user_exists/2,
+	 remove_user/2, remove_user/3, store_type/0,
+	 plain_password_required/0]).
 
-%%====================================================================
-%% API
-%%====================================================================
 start(_Host) ->
     case epam:start() of
-	{ok, _} -> ok;
-	{error,{already_started, _}} -> ok;
-	Err -> Err
+      {ok, _} -> ok;
+      {error, {already_started, _}} -> ok;
+      Err -> Err
     end.
 
 set_password(_User, _Server, _Password) ->
     {error, not_allowed}.
 
-check_password(User, Server, Password, _Digest, _DigestGen) ->
+check_password(User, Server, Password, _Digest,
+	       _DigestGen) ->
     check_password(User, Server, Password).
 
 check_password(User, Host, Password) ->
     Service = get_pam_service(Host),
     UserInfo = case get_pam_userinfotype(Host) of
-	username -> User;
-	jid -> User++"@"++Host
-    end,
-    case catch epam:authenticate(Service, UserInfo, Password) of
-	true -> true;
-	_    -> false
+		 username -> User;
+		 jid -> <<User/binary, "@", Host/binary>>
+	       end,
+    case catch epam:authenticate(Service, UserInfo,
+				 Password)
+	of
+      true -> true;
+      _ -> false
     end.
 
 try_register(_User, _Server, _Password) ->
     {error, not_allowed}.
 
-dirty_get_registered_users() ->
-    [].
+dirty_get_registered_users() -> [].
 
-get_vh_registered_users(_Host) ->
-    [].
+get_vh_registered_users(_Host) -> [].
 
-get_password(_User, _Server) ->
-    false.
+get_vh_registered_users(_Host, _) -> [].
 
-get_password_s(_User, _Server) ->
-    "".
+get_vh_registered_users_number(_Host) -> 0.
+
+get_vh_registered_users_number(_Host, _) -> 0.
+
+get_password(_User, _Server) -> false.
+
+get_password_s(_User, _Server) -> <<"">>.
 
-%% @spec (User, Server) -> true | false | {error, Error}
-%% TODO: Improve this function to return an error instead of 'false' when connection to PAM failed
 is_user_exists(User, Host) ->
     Service = get_pam_service(Host),
     UserInfo = case get_pam_userinfotype(Host) of
-	username -> User;
-	jid -> User++"@"++Host
-    end,
+		 username -> User;
+		 jid -> <<User/binary, "@", Host/binary>>
+	       end,
     case catch epam:acct_mgmt(Service, UserInfo) of
-	true -> true;
-	_    -> false
+      true -> true;
+      _ -> false
     end.
 
-remove_user(_User, _Server) ->
-    {error, not_allowed}.
+remove_user(_User, _Server) -> {error, not_allowed}.
 
-remove_user(_User, _Server, _Password) ->
-    not_allowed.
+remove_user(_User, _Server, _Password) -> not_allowed.
 
-plain_password_required() ->
-    true.
+plain_password_required() -> true.
 
-store_type() ->
-	external.
+store_type() -> external.
 
-%%====================================================================
-%% Internal functions
-%%====================================================================
 get_pam_service(Host) ->
-    case ejabberd_config:get_local_option({pam_service, Host}) of
-	undefined -> "ejabberd";
-	Service   -> Service
-    end.
+    ejabberd_config:get_local_option(
+      {pam_service, Host},
+      fun iolist_to_binary/1,
+      <<"ejabberd">>).
+
 get_pam_userinfotype(Host) ->
-    case ejabberd_config:get_local_option({pam_userinfotype, Host}) of
-	undefined -> username;
-	Type -> Type
-    end.
+    ejabberd_config:get_local_option(
+      {pam_userinfotype, Host},
+      fun(username) -> username;
+         (jid) -> jid
+      end,
+      username).

src/ejabberd_auth_riak.erl

@@ -0,0 +1,285 @@
+%%%----------------------------------------------------------------------
+%%% File    : ejabberd_auth_riak.erl
+%%% Author  : Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%% Purpose : Authentification via Riak
+%%% Created : 12 Nov 2012 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2013   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., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-module(ejabberd_auth_riak).
+
+-author('alexey@process-one.net').
+
+-behaviour(ejabberd_auth).
+
+%% External exports
+-export([start/1, set_password/3, check_password/3,
+	 check_password/5, try_register/3,
+	 dirty_get_registered_users/0, get_vh_registered_users/1,
+	 get_vh_registered_users/2,
+	 get_vh_registered_users_number/1,
+	 get_vh_registered_users_number/2, get_password/2,
+	 get_password_s/2, is_user_exists/2, remove_user/2,
+	 remove_user/3, store_type/0, export/1,
+	 plain_password_required/0]).
+
+-include("ejabberd.hrl").
+
+-record(passwd, {us = {<<"">>, <<"">>} :: {binary(), binary()} | '$1',
+                 password = <<"">> :: binary() | scram() | '_'}).
+
+-define(SALT_LENGTH, 16).
+
+start(_Host) ->
+    ok.
+
+plain_password_required() ->
+    case is_scrammed() of
+      false -> false;
+      true -> true
+    end.
+
+store_type() ->
+    case is_scrammed() of
+      false -> plain; %% allows: PLAIN DIGEST-MD5 SCRAM
+      true -> scram %% allows: PLAIN SCRAM
+    end.
+
+check_password(User, Server, Password) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    case ejabberd_riak:get(passwd, {LUser, LServer}) of
+        {ok, #passwd{password = Password}} when is_binary(Password) ->
+            Password /= <<"">>;
+        {ok, #passwd{password = Scram}} when is_record(Scram, scram) ->
+            is_password_scram_valid(Password, Scram);
+        _ ->
+            false
+    end.
+
+check_password(User, Server, Password, Digest,
+	       DigestGen) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    case ejabberd_riak:get(passwd, {LUser, LServer}) of
+      {ok, #passwd{password = Passwd}} when is_binary(Passwd) ->
+	  DigRes = if Digest /= <<"">> ->
+			  Digest == DigestGen(Passwd);
+		      true -> false
+		   end,
+	  if DigRes -> true;
+	     true -> (Passwd == Password) and (Password /= <<"">>)
+	  end;
+      {ok, #passwd{password = Scram}}
+	  when is_record(Scram, scram) ->
+	  Passwd = jlib:decode_base64(Scram#scram.storedkey),
+	  DigRes = if Digest /= <<"">> ->
+			  Digest == DigestGen(Passwd);
+		      true -> false
+		   end,
+	  if DigRes -> true;
+	     true -> (Passwd == Password) and (Password /= <<"">>)
+	  end;
+      _ -> false
+    end.
+
+set_password(User, Server, Password) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    US = {LUser, LServer},
+    if (LUser == error) or (LServer == error) ->
+	   {error, invalid_jid};
+       true ->
+            Password2 = case is_scrammed() and is_binary(Password)
+                        of
+                            true -> password_to_scram(Password);
+                            false -> Password
+                        end,
+            ok = ejabberd_riak:put(#passwd{us = US, password = Password2},
+                                   [{'2i', [{<<"host">>, LServer}]}])
+    end.
+
+try_register(User, Server, PasswordList) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    Password = iolist_to_binary(PasswordList),
+    US = {LUser, LServer},
+    if (LUser == error) or (LServer == error) ->
+	   {error, invalid_jid};
+       true ->
+            case ejabberd_riak:get(passwd, US) of
+                {error, notfound} ->
+                    Password2 = case is_scrammed() and
+                                    is_binary(Password)
+                                of
+                                    true -> password_to_scram(Password);
+                                    false -> Password
+                                end,
+                    {atomic, ejabberd_riak:put(
+                               #passwd{us = US,
+                                       password = Password2},
+                               [{'2i', [{<<"host">>, LServer}]}])};
+                {ok, _} ->
+                    exists;
+                Err ->
+                    {atomic, Err}
+            end
+    end.
+
+dirty_get_registered_users() ->
+    lists:flatmap(
+      fun(Server) ->
+              get_vh_registered_users(Server)
+      end, ejabberd_config:get_vh_by_auth_method(riak)).
+
+get_vh_registered_users(Server) ->
+    LServer = jlib:nameprep(Server),
+    case ejabberd_riak:get_keys_by_index(passwd, <<"host">>, LServer) of
+        {ok, Users} ->
+            Users;
+        _ ->
+            []
+    end.
+
+get_vh_registered_users(Server, _) ->
+    get_vh_registered_users(Server).
+
+get_vh_registered_users_number(Server) ->
+    LServer = jlib:nameprep(Server),
+    case ejabberd_riak:count_by_index(passwd, <<"host">>, LServer) of
+        {ok, N} ->
+            N;
+        _ ->
+            0
+    end.
+
+get_vh_registered_users_number(Server, _) ->
+    get_vh_registered_users_number(Server).
+
+get_password(User, Server) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    case ejabberd_riak:get(passwd, {LUser, LServer}) of
+      {ok, #passwd{password = Password}}
+	  when is_binary(Password) ->
+	  Password;
+      {ok, #passwd{password = Scram}}
+	  when is_record(Scram, scram) ->
+	  {jlib:decode_base64(Scram#scram.storedkey),
+	   jlib:decode_base64(Scram#scram.serverkey),
+	   jlib:decode_base64(Scram#scram.salt),
+	   Scram#scram.iterationcount};
+      _ -> false
+    end.
+
+get_password_s(User, Server) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    case ejabberd_riak:get(passwd, {LUser, LServer}) of
+      {ok, #passwd{password = Password}}
+	  when is_binary(Password) ->
+	  Password;
+      {ok, #passwd{password = Scram}}
+	  when is_record(Scram, scram) ->
+	  <<"">>;
+      _ -> <<"">>
+    end.
+
+is_user_exists(User, Server) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    case ejabberd_riak:get(passwd, {LUser, LServer}) of
+      {error, notfound} -> false;
+      {ok, _} -> true;
+      Err -> Err
+    end.
+
+remove_user(User, Server) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    ejabberd_riak:delete(passwd, {LUser, LServer}),
+    ok.
+
+remove_user(User, Server, Password) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Server),
+    case ejabberd_riak:get(passwd, {LUser, LServer}) of
+        {ok, #passwd{password = Password}}
+          when is_binary(Password) ->
+            ejabberd_riak:delete(passwd, {LUser, LServer}),
+            ok;
+        {ok, #passwd{password = Scram}}
+          when is_record(Scram, scram) ->
+            case is_password_scram_valid(Password, Scram) of
+                true ->
+                    ejabberd_riak:delete(passwd, {LUser, LServer}),
+                    ok;
+                false -> not_allowed
+            end;
+        _ -> not_exists
+    end.
+
+%%%
+%%% SCRAM
+%%%
+
+is_scrammed() ->
+    scram ==
+      ejabberd_config:get_local_option({auth_password_format, ?MYNAME},
+                                       fun(V) -> V end).
+
+password_to_scram(Password) ->
+    password_to_scram(Password,
+		      ?SCRAM_DEFAULT_ITERATION_COUNT).
+
+password_to_scram(Password, IterationCount) ->
+    Salt = crypto:rand_bytes(?SALT_LENGTH),
+    SaltedPassword = scram:salted_password(Password, Salt,
+					   IterationCount),
+    StoredKey =
+	scram:stored_key(scram:client_key(SaltedPassword)),
+    ServerKey = scram:server_key(SaltedPassword),
+    #scram{storedkey = jlib:encode_base64(StoredKey),
+	   serverkey = jlib:encode_base64(ServerKey),
+	   salt = jlib:encode_base64(Salt),
+	   iterationcount = IterationCount}.
+
+is_password_scram_valid(Password, Scram) ->
+    IterationCount = Scram#scram.iterationcount,
+    Salt = jlib:decode_base64(Scram#scram.salt),
+    SaltedPassword = scram:salted_password(Password, Salt,
+					   IterationCount),
+    StoredKey =
+	scram:stored_key(scram:client_key(SaltedPassword)),
+    jlib:decode_base64(Scram#scram.storedkey) == StoredKey.
+
+export(_Server) ->
+    [{passwd,
+      fun(Host, #passwd{us = {LUser, LServer}, password = Password})
+            when LServer == Host ->
+              Username = ejabberd_odbc:escape(LUser),
+              Pass = ejabberd_odbc:escape(Password),
+              [[<<"delete from users where username='">>, Username, <<"';">>],
+               [<<"insert into users(username, password) "
+                  "values ('">>, Username, <<"', '">>, Pass, <<"');">>]];
+         (_Host, _R) ->
+              []
+      end}].

src/ejabberd_c2s.hrl

@@ -0,0 +1,93 @@
+%%%----------------------------------------------------------------------
+%%%
+%%% ejabberd, Copyright (C) 2002-2013   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., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-ifndef(mod_privacy_hrl).
+
+-include("mod_privacy.hrl").
+
+-endif.
+
+%-define(SETS, gb_sets).
+-define(SETS, ejabberd_sets).
+
+-define(DICT, dict).
+
+-record(state,
+	{socket,
+         sockmod = ejabberd_socket :: ejabberd_socket | ejabberd_frontend_socket,
+         socket_monitor = make_ref() :: reference(),
+         xml_socket = false :: boolean(),
+         streamid = <<"">> :: binary(),
+	 sasl_state :: any(),
+         access :: atom(),
+         shaper = none :: shaper:shaper(),
+         zlib = false :: boolean(),
+         tls = false :: boolean(),
+	 tls_required = false :: boolean(),
+         tls_enabled = false :: boolean(),
+	 tls_options = [] :: list(),
+         authenticated = false :: boolean() | replaced | rebinded,
+         jid = #jid{} :: jid(),
+	 user = <<"">> :: binary(),
+         server = ?MYNAME :: binary(),
+         resource = <<"">> :: binary(),
+         sid = {now(), self()} :: ejabberd_sm:sid(),
+	 pres_t = (?SETS):new() :: ?SETS:ej_set() | {pres_t, non_neg_integer()},
+         pres_f = (?SETS):new() :: ?SETS:ej_set() | {pres_f, non_neg_integer()},
+	 pres_a = (?SETS):new() :: ?SETS:ej_set() | {pres_a, non_neg_integer()},
+	 pres_last :: xmlel(),
+         pres_timestamp :: calendar:datetime(),
+	 privacy_list = #userlist{} :: userlist(),
+         conn = unknown :: atom(),
+	 auth_module = unknown :: atom(),
+         ip :: {inet:ip_address(), inet:port_number()},
+         redirect = false :: boolean(),
+	 aux_fields = [] :: [{atom(), any()}],
+         fsm_limit_opts = [] :: [{atom(), any()}],
+         lang = ?MYLANG :: binary(),
+         debug = false :: boolean(),
+         flash_hack = false :: boolean(),
+	 flash_connection = false :: boolean(),
+         reception = true :: boolean(),
+	 standby = false :: boolean(),
+         queue = queue:new() :: queue(),
+         queue_len = 0 :: integer(),
+	 pres_queue = gb_trees:empty() :: gb_tree(),
+         keepalive_timer :: reference(),
+	 keepalive_timeout :: timeout(),
+         oor_timeout :: timeout(),
+         oor_status = <<"">> :: binary(),
+	 oor_show = <<"">> :: binary(),
+         oor_notification :: xmlel(),
+	 oor_send_body = all :: first_per_user | first | all | none,
+         oor_send_groupchat = false :: boolean(),
+	 oor_send_from = jid :: jid | username | name | none,
+         oor_appid = <<"">> :: binary(),
+         oor_unread = 0 :: integer(),
+	 oor_unread_users = (?SETS):new() :: ?SETS:ej_set(),
+         oor_unread_client = 0 :: integer(),
+	 oor_offline = false :: boolean(),
+         ack_enabled = false :: boolean(),
+	 ack_counter = 0 :: integer(),
+         ack_queue = queue:new() :: queue(),
+         ack_timer :: reference()}).
+
+-type c2s_state() :: #state{}.

src/ejabberd_c2s_config.erl

@@ -6,7 +6,7 @@
 %%% Created :  2 Nov 2007 by Mickael Remond <mremond@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -26,35 +26,38 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_c2s_config).
+
 -author('mremond@process-one.net').
 
 -export([get_c2s_limits/0]).
 
-%% Get first c2s configuration limitations to apply it to other c2s
-%% connectors.
 get_c2s_limits() ->
-    case ejabberd_config:get_local_option(listen) of
-	undefined ->
-	    [];
-	C2SFirstListen ->
-	    case lists:keysearch(ejabberd_c2s, 2, C2SFirstListen) of
-		false ->
-		    [];
-		{value, {_Port, ejabberd_c2s, Opts}} ->
-		    select_opts_values(Opts)
-	    end
+    case ejabberd_config:get_local_option(listen, fun(V) -> V end) of
+      undefined -> [];
+      C2SFirstListen ->
+	  case lists:keysearch(ejabberd_c2s, 2, C2SFirstListen) of
+	    false -> [];
+	    {value, {_Port, ejabberd_c2s, Opts}} ->
+		select_opts_values(Opts)
+	  end
     end.
-%% Only get access, shaper and max_stanza_size values
+
 select_opts_values(Opts) ->
     select_opts_values(Opts, []).
+
 select_opts_values([], SelectedValues) ->
     SelectedValues;
-select_opts_values([{access,Value}|Opts], SelectedValues) ->
-    select_opts_values(Opts, [{access, Value}|SelectedValues]);
-select_opts_values([{shaper,Value}|Opts], SelectedValues) ->
-    select_opts_values(Opts, [{shaper, Value}|SelectedValues]);
-select_opts_values([{max_stanza_size,Value}|Opts], SelectedValues) ->
-    select_opts_values(Opts, [{max_stanza_size, Value}|SelectedValues]);
-select_opts_values([_Opt|Opts], SelectedValues) ->
+select_opts_values([{access, Value} | Opts],
+		   SelectedValues) ->
+    select_opts_values(Opts,
+		       [{access, Value} | SelectedValues]);
+select_opts_values([{shaper, Value} | Opts],
+		   SelectedValues) ->
+    select_opts_values(Opts,
+		       [{shaper, Value} | SelectedValues]);
+select_opts_values([{max_stanza_size, Value} | Opts],
+		   SelectedValues) ->
+    select_opts_values(Opts,
+		       [{max_stanza_size, Value} | SelectedValues]);
+select_opts_values([_Opt | Opts], SelectedValues) ->
     select_opts_values(Opts, SelectedValues).
-

src/ejabberd_check.erl

@@ -5,7 +5,7 @@
 %%% Created : 27 Feb 2008 by Mickael Remond <mremond@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -31,8 +31,6 @@
 -include("ejabberd.hrl").
 -include("ejabberd_config.hrl").
 
--compile([export_all]).
-
 %% TODO:
 %% We want to implement library checking at launch time to issue
 %% human readable user messages.
@@ -87,7 +85,7 @@ get_db_used() ->
 	    fun([Domain, DB], Acc) ->
 		    case check_odbc_option(
 			   ejabberd_config:get_local_option(
-			     {auth_method, Domain})) of
+			     {auth_method, Domain}, fun(V) -> V end)) of
 			true -> [get_db_type(DB)|Acc];
 			_ -> Acc
 		    end

src/ejabberd_cluster.erl

@@ -0,0 +1,257 @@
+%%%-------------------------------------------------------------------
+%%% File    : ejabberd_cluster.erl
+%%% Author  : Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%% Description :
+%%%
+%%% Created :  2 Apr 2010 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(ejabberd_cluster).
+
+-behaviour(gen_server).
+
+%% API
+-export([start_link/0, get_node/1, get_node_new/1,
+	 announce/1, shutdown/0, node_id/0, get_node_by_id/1,
+	 get_nodes/0, rehash_timeout/0, start/0,
+	 shutdown_migrate/1, migrate_timeout/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, terminate/2, code_change/3]).
+
+-include("ejabberd.hrl").
+
+-define(HASHTBL, nodes_hash).
+
+-define(HASHTBL_NEW, nodes_hash_new).
+
+-define(POINTS, 64).
+
+-define(REHASH_TIMEOUT, timer:seconds(30)).
+
+-define(MIGRATE_TIMEOUT, timer:minutes(2)).
+
+-define(LOCK, {migrate, node()}).
+
+-record(state, {}).
+-record(?HASHTBL, {hash, node}).
+-record(?HASHTBL_NEW, {hash, node}).
+
+start() ->
+    ChildSpec = {?MODULE, {?MODULE, start_link, []},
+		 permanent, brutal_kill, worker, [?MODULE]},
+    supervisor:start_child(ejabberd_sup, ChildSpec).
+
+start_link() -> gen_server:start_link(?MODULE, [], []).
+
+-spec get_node(any()) -> atom().
+
+get_node(Key) ->
+    Hash = erlang:phash2(Key),
+    get_node_by_hash(?HASHTBL, Hash).
+
+-spec get_node_new(any()) -> atom().
+
+get_node_new(Key) ->
+    Hash = erlang:phash2(Key),
+    get_node_by_hash(?HASHTBL_NEW, Hash).
+
+-spec get_nodes() -> [atom()].
+
+get_nodes() -> mnesia:system_info(running_db_nodes).
+
+-spec announce(pid()) -> any().
+
+announce(Pid) ->
+    gen_server:call(Pid, announce, infinity).
+
+node_id() ->
+    jlib:integer_to_binary(erlang:phash2(node())).
+
+rehash_timeout() ->
+    case ejabberd_config:get_local_option(
+           rehash_timeout,
+           fun(I) when is_integer(I), I > 0 -> I end) of
+        undefined -> ?REHASH_TIMEOUT;
+        Secs -> timer:seconds(Secs)
+    end.
+
+migrate_timeout() ->
+    case ejabberd_config:get_local_option(
+           migrate_timeout,
+           fun(N) when is_integer(N), N > 0 -> N end) of
+        undefined -> ?MIGRATE_TIMEOUT;
+        Secs -> timer:seconds(Secs)
+    end.
+
+-spec get_node_by_id(binary() | atom()) -> atom().
+
+get_node_by_id(NodeID) when is_binary(NodeID) ->
+    case catch list_to_existing_atom(binary_to_list(NodeID)) of
+      {'EXIT', _} -> node();
+      Res -> get_node_by_id(Res)
+    end;
+get_node_by_id(NodeID) ->
+    case global:whereis_name(NodeID) of
+      Pid when is_pid(Pid) -> node(Pid);
+      _ -> node()
+    end.
+
+shutdown() ->
+    lists:foreach(fun (Node) when Node /= node() ->
+			  {ejabberd_cluster, Node} ! {node_down, node()};
+		      (_) -> ok
+		  end,
+		  get_nodes()).
+
+shutdown_migrate(WaitTime) ->
+    delete_node(?HASHTBL_NEW, node()),
+    ejabberd_hooks:run(node_down, [node()]),
+    shutdown(),
+    delete_node(?HASHTBL, node()),
+    ejabberd_hooks:run(node_hash_update,
+		       [node(), down, WaitTime]),
+    ?INFO_MSG("Waiting ~p seconds for the migration "
+	      "to be completed.",
+	      [WaitTime div 1000]),
+    timer:sleep(WaitTime),
+    ok.
+
+init([]) ->
+    {A, B, C} = now(),
+    random:seed(A, B, C),
+    net_kernel:monitor_nodes(true, [{node_type, visible}]),
+    mnesia:create_table(?HASHTBL,
+                        [{ram_copies, [node()]},
+                         {type, ordered_set},
+			 {local_content, true},
+			 {attributes, record_info(fields, ?HASHTBL)}]),
+    mnesia:create_table(?HASHTBL_NEW,
+                        [{ram_copies, [node()]},
+                         {type, ordered_set},
+			 {local_content, true},
+			 {attributes, record_info(fields, ?HASHTBL_NEW)}]),
+    mnesia:add_table_copy(?HASHTBL, node(), ram_copies),
+    mnesia:add_table_copy(?HASHTBL_NEW, node(), ram_copies),
+    mnesia:clear_table(?HASHTBL),
+    mnesia:clear_table(?HASHTBL_NEW),
+    register_node(),
+    AllNodes = get_nodes(),
+    OtherNodes = case AllNodes of
+		   [_MyNode] -> AllNodes;
+		   _ -> AllNodes -- [node()]
+		 end,
+    append_nodes(?HASHTBL, OtherNodes),
+    append_nodes(?HASHTBL_NEW, AllNodes),
+    {ok, #state{}}.
+
+handle_call(announce, _From, State) ->
+    Migrate_timeout = migrate_timeout(),
+    case global:set_lock(?LOCK, get_nodes(), 0) of
+      false ->
+	  ?WARNING_MSG("Another node is recently attached to "
+		       "the cluster and is being rebalanced. "
+		       "Waiting for the rebalancing to be completed "
+		       "before starting this node. This will "
+		       "take at least ~p seconds. Please, be "
+		       "patient.",
+		       [Migrate_timeout div 1000]),
+	  global:set_lock(?LOCK, get_nodes(), infinity);
+      true -> ok
+    end,
+    case get_nodes() of
+      [_MyNode] ->
+	  register(?MODULE, self()), global:del_lock(?LOCK);
+      Nodes ->
+	  OtherNodes = Nodes -- [node()],
+	  ?INFO_MSG("waiting for migration from nodes: ~w",
+		    [OtherNodes]),
+	  {_Res, BadNodes} = gen_server:multi_call(OtherNodes,
+						   ?MODULE,
+						   {node_ready, node()},
+						   ?REHASH_TIMEOUT),
+	  append_node(?HASHTBL, node()),
+	  register(?MODULE, self()),
+	  case OtherNodes -- BadNodes of
+	    [] -> global:del_lock(?LOCK);
+	    WorkingNodes ->
+		gen_server:abcast(WorkingNodes, ?MODULE,
+				  {node_ready, node()}),
+		erlang:send_after(Migrate_timeout, self(), del_lock)
+	  end
+    end,
+    {reply, ok, State};
+handle_call({node_ready, Node}, _From, State) ->
+    ?INFO_MSG("node ~p is ready, preparing migration",
+	      [Node]),
+    append_node(?HASHTBL_NEW, Node),
+    ejabberd_hooks:run(node_up, [Node]),
+    {reply, ok, State};
+handle_call(_Request, _From, State) ->
+    Reply = ok, {reply, Reply, State}.
+
+handle_cast({node_ready, Node}, State) ->
+    ?INFO_MSG("adding node ~p to hash and starting "
+	      "migration",
+	      [Node]),
+    append_node(?HASHTBL, Node),
+    ejabberd_hooks:run(node_hash_update,
+		       [Node, up, migrate_timeout()]),
+    {noreply, State};
+handle_cast(_Msg, State) -> {noreply, State}.
+
+handle_info(del_lock, State) ->
+    global:del_lock(?LOCK), {noreply, State};
+handle_info({node_down, Node}, State) ->
+    delete_node(?HASHTBL, Node),
+    delete_node(?HASHTBL_NEW, Node),
+    {noreply, State};
+handle_info({nodedown, Node, _}, State) ->
+    ?INFO_MSG("node ~p goes down", [Node]),
+    ejabberd_hooks:run(node_down, [Node]),
+    delete_node(?HASHTBL, Node),
+    delete_node(?HASHTBL_NEW, Node),
+    {noreply, State};
+handle_info(_Info, State) -> {noreply, State}.
+
+terminate(_Reason, _State) -> ok.
+
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
+
+append_nodes(Tab, Nodes) ->
+    lists:foreach(fun (Node) -> append_node(Tab, Node) end,
+		  Nodes).
+
+append_node(Tab, Node) ->
+    lists:foreach(
+      fun(I) ->
+              Hash = erlang:phash2({I, Node}),
+              mnesia:dirty_write({Tab, Hash, Node})
+      end, lists:seq(1, ?POINTS)).
+
+delete_node(Tab, Node) ->
+    lists:foreach(
+      fun(I) ->
+              Hash = erlang:phash2({I, Node}),
+              mnesia:dirty_delete(Tab, Hash)
+      end, lists:seq(1, ?POINTS)).
+
+get_node_by_hash(Tab, Hash) ->
+    NodeHash = case ets:next(Tab, Hash) of
+		 '$end_of_table' -> ets:first(Tab);
+		 NH -> NH
+	       end,
+    if NodeHash == '$end_of_table' ->
+            node();
+       true ->
+	    case ets:lookup(Tab, NodeHash) of
+		[] ->
+		    get_node_by_hash(Tab, Hash);
+		[{_, _, Node}] ->
+		    Node
+	    end
+    end.
+
+register_node() ->
+    global:register_name(jlib:binary_to_atom(node_id()),
+			 self()).

src/ejabberd_commands.erl

@@ -5,7 +5,7 @@
 %%% Created : 20 May 2008 by Badlop <badlop@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -226,9 +226,22 @@
 
 init() ->
     ets:new(ejabberd_commands, [named_table, set, public,
-				{keypos, #ejabberd_commands.name}]).
+				{keypos, #ejabberd_commands.name}]),
+    register_commands([
+        #ejabberd_commands{name = gen_xmlrpc_docs, tags = [documentation],
+                           desc = "Generates html documentation for ejabberd_commands",
+                           module = ejabberd_commands_doc, function = generate_output,
+                           args = [{file, binary}, {regexp, binary}],
+                           result = {res, rescode},
+                           args_desc = [<<"Path to file where generated documentation should be stored">>,
+                                        <<"Commands which name or module is matched by it will be included in output">>],
+                           result_desc = <<"0 if command failed, 1 when succedded">>,
+                           args_example = [<<"/home/me/docs/api.html">>, <<"mod_admin">>],
+                           result_example = ok}]).
+
+
+-spec register_commands([ejabberd_commands()]) -> ok.
 
-%% @spec ([ejabberd_commands()]) -> ok
 %% @doc Register ejabberd commands.
 %% If a command is already registered, a warning is printed and the old command is preserved.
 register_commands(Commands) ->
@@ -243,7 +256,8 @@ register_commands(Commands) ->
       end,
       Commands).
 
-%% @spec ([ejabberd_commands()]) -> ok
+-spec unregister_commands([ejabberd_commands()]) -> ok.
+
 %% @doc Unregister ejabberd commands.
 unregister_commands(Commands) ->
     lists:foreach(
@@ -252,7 +266,8 @@ unregister_commands(Commands) ->
       end,
       Commands).
 
-%% @spec () -> [{Name::atom(), Args::[aterm()], Desc::string()}]
+-spec list_commands() -> [{atom(), [aterm()], string()}].
+
 %% @doc Get a list of all the available commands, arguments and description.
 list_commands() ->
     Commands = ets:match(ejabberd_commands,
@@ -262,7 +277,8 @@ list_commands() ->
 					    _ = '_'}),
     [{A, B, C} || [A, B, C] <- Commands].
 
-%% @spec (Name::atom()) -> {Args::[aterm()], Result::rterm()} | {error, command_unknown}
+-spec get_command_format(atom()) -> {[aterm()], rterm()} | {error, command_unknown}.
+
 %% @doc Get the format of arguments and result of a command.
 get_command_format(Name) ->
     Matched = ets:match(ejabberd_commands,
@@ -277,7 +293,8 @@ get_command_format(Name) ->
 	    {Args, Result}
     end.
 
-%% @spec (Name::atom()) -> ejabberd_commands() | command_not_found
+-spec get_command_definition(atom()) -> ejabberd_commands() | command_not_found.
+
 %% @doc Get the definition record of a command.
 get_command_definition(Name) ->
     case ets:lookup(ejabberd_commands, Name) of
@@ -291,7 +308,7 @@ execute_command(Name, Arguments) ->
     execute_command([], noauth, Name, Arguments).
 
 %% @spec (AccessCommands, Auth, Name::atom(), Arguments) -> ResultTerm | {error, Error}
-%% where 
+%% where
 %%       AccessCommands = [{Access, CommandNames, Arguments}]
 %%       Auth = {User::string(), Server::string(), Password::string()} | noauth
 %%       Method = atom()
@@ -314,6 +331,8 @@ execute_command2(Command, Arguments) ->
     ?DEBUG("Executing command ~p:~p with Args=~p", [Module, Function, Arguments]),
     apply(Module, Function, Arguments).
 
+-spec get_tags_commands() -> [{string(), [string()]}].
+
 %% @spec () -> [{Tag::string(), [CommandName::string()]}]
 %% @doc Get all the tags and associated commands.
 get_tags_commands() ->
@@ -348,7 +367,7 @@ get_tags_commands() ->
 %% -----------------------------
 
 %% @spec (AccessCommands, Auth, Method, Command, Arguments) -> ok
-%% where 
+%% where
 %%       AccessCommands =  [ {Access, CommandNames, Arguments} ]
 %%       Auth = {User::string(), Server::string(), Password::string()} | noauth
 %%       Method = atom()
@@ -377,6 +396,9 @@ check_access_commands(AccessCommands, Auth, Method, Command, Arguments) ->
 	L when is_list(L) -> ok
     end.
 
+-spec check_auth(noauth) -> noauth_provided;
+                ({binary(), binary(), binary()}) -> {ok, binary(), binary()}.
+
 check_auth(noauth) ->
     no_auth_provided;
 check_auth({User, Server, Password}) ->
@@ -390,15 +412,15 @@ check_auth({User, Server, Password}) ->
     end.
 
 get_md5(AccountPass) ->
-    lists:flatten([io_lib:format("~.16B", [X])
-		   || X <- binary_to_list(crypto:md5(AccountPass))]).
+    list_to_binary([io_lib:format("~.16B", [X])
+                    || X <- binary_to_list(crypto:md5(AccountPass))]).
 
 check_access(all, _) ->
     true;
 check_access(Access, Auth) ->
     {ok, User, Server} = check_auth(Auth),
     %% Check this user has access permission
-    case acl:match_rule(Server, Access, jlib:make_jid(User, Server, "")) of
+    case acl:match_rule(Server, Access, jlib:make_jid(User, Server, <<"">>)) of
 	allow -> true;
 	deny -> false
     end.
@@ -422,8 +444,8 @@ check_access_arguments(Command, ArgumentRestrictions, Arguments) ->
 
 tag_arguments(ArgsDefs, Args) ->
     lists:zipwith(
-      fun({ArgName, _ArgType}, ArgValue) -> 
+      fun({ArgName, _ArgType}, ArgValue) ->
 	      {ArgName, ArgValue}
-      end, 
+      end,
       ArgsDefs,
       Args).

src/ejabberd_commands.hrl

@@ -1,6 +1,6 @@
 %%%----------------------------------------------------------------------
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -19,10 +19,40 @@
 %%%
 %%%----------------------------------------------------------------------
 
--record(ejabberd_commands, {name, tags = [],
-			   desc = "", longdesc = "",
-			   module, function,
-			   args = [], result = rescode}).
+-type aterm() :: {atom(), atype()}.
+-type atype() :: integer | string | binary |
+                 {tuple, [aterm()]} | {list, aterm()}.
+-type rterm() :: {atom(), rtype()}.
+-type rtype() :: integer | string | atom |
+                 {tuple, [rterm()]} | {list, rterm()} |
+                 rescode | restuple.
+
+-record(ejabberd_commands,
+	{name                    :: atom(),
+         tags = []               :: [atom()] | '_' | '$2',
+         desc = ""               :: string() | '_' | '$3',
+         longdesc = ""           :: string() | '_',
+	 module                  :: atom(),
+         function                :: atom(),
+         args = []               :: [aterm()] | '_' | '$1' | '$2',
+         result = {res, rescode} :: rterm() | '_' | '$2',
+         args_desc = none        :: none | [string()],
+         result_desc = none      :: none | string(),
+         args_example = none     :: [any()],
+         result_example = none   :: any()}).
+
+-type ejabberd_commands() :: #ejabberd_commands{name :: atom(),
+                                                tags :: [atom()],
+                                                desc :: string(),
+                                                longdesc :: string(),
+                                                module :: atom(),
+                                                function :: atom(),
+                                                args :: [aterm()],
+                                                result :: rterm(),
+                                                args_desc :: none | [string()],
+                                                result_desc :: none | string(),
+                                                args_example :: [any()],
+                                                result_example :: any()}.
 
 %% @type ejabberd_commands() = #ejabberd_commands{
 %%    name = atom(),

src/ejabberd_commands_doc.erl

@@ -0,0 +1,415 @@
+%%%----------------------------------------------------------------------
+%%% File    : ejabberd_commands_doc.erl
+%%% Author  : Badlop <badlop@process-one.net>
+%%% Purpose : Management of ejabberd commands
+%%% Created : 20 May 2008 by Badlop <badlop@process-one.net>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2013   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., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-module(ejabberd_commands_doc).
+-author('pawel@process-one.net').
+
+-export([generate_output/2]).
+
+-include("ejabberd_commands.hrl").
+-include("ejabberd.hrl").
+
+-define(RAW(V), xml:crypt(iolist_to_binary(V))).
+-define(TAG(N), <<"<", ??N, "/>">>).
+-define(TAG(N, V), <<"<", ??N, ">">>, V, <<"</", ??N, ">">>).
+-define(TAG(N, C, V), <<"<", ??N, " class='", C, "'>">>, V, <<"</", ??N, ">">>).
+-define(TAG_R(N, V), ?TAG(N, ?RAW(V))).
+-define(TAG_R(N, C, V), ?TAG(N, C, ?RAW(V))).
+-define(SPAN(N, V), ?TAG_R(span, ??N, V)).
+
+-define(STR(A), ?SPAN(str,[<<"\"">>, A, <<"\"">>])).
+-define(NUM(A), ?SPAN(num,jlib:integer_to_binary(A))).
+-define(FIELD(A), ?SPAN(field,A)).
+-define(ID(A), ?SPAN(id,A)).
+-define(OP(A), ?SPAN(op,A)).
+-define(ARG(A), ?FIELD(atom_to_list(A))).
+-define(KW(A), ?SPAN(kw,A)).
+-define(BR, <<"\n">>).
+
+-define(RAW_L(A), ?RAW(<<A>>)).
+-define(STR_L(A), ?STR(<<A>>)).
+-define(FIELD_L(A), ?FIELD(<<A>>)).
+-define(ID_L(A), ?ID(<<A>>)).
+-define(OP_L(A), ?OP(<<A>>)).
+-define(KW_L(A), ?KW(<<A>>)).
+
+-define(STR_A(A), ?STR(atom_to_list(A))).
+-define(ID_A(A), ?ID(atom_to_list(A))).
+
+list_join_with([], _M) ->
+    [];
+list_join_with([El|Tail], M) ->
+    lists:reverse(lists:foldl(fun(E, Acc) ->
+                                      [E, M | Acc]
+                              end, [El], Tail)).
+
+rescode_to_int(ok) ->
+    0;
+rescode_to_int(true) ->
+    0;
+rescode_to_int(_) ->
+    1.
+
+perl_gen({Name, integer}, Int, _Indent) ->
+    [?ARG(Name), ?OP_L(" => "), ?NUM(Int)];
+perl_gen({Name, string}, Str, _Indent) ->
+    [?ARG(Name), ?OP_L(" => "), ?STR(Str)];
+perl_gen({Name, binary}, Str, _Indent) ->
+    [?ARG(Name), ?OP_L(" => "), ?STR(Str)];
+perl_gen({Name, atom}, Atom, _Indent) ->
+    [?ARG(Name), ?OP_L(" => "), ?STR(atom_to_list(Atom))];
+perl_gen({Name, {tuple, Fields}}, Tuple, Indent) ->
+    Res = lists:map(fun({A,B})->perl_gen(A, B, Indent) end, lists:zip(Fields, tuple_to_list(Tuple))),
+    [?ARG(Name), ?OP_L(" => {"), list_join_with(Res, [?OP_L(", ")]), ?OP_L("}")];
+perl_gen({Name, {list, ElDesc}}, List, Indent) ->
+    Res = lists:map(fun(E) -> [?OP_L("{"), perl_gen(ElDesc, E, Indent), ?OP_L("}")] end, List),
+    [?ARG(Name), ?OP_L(" => ["), list_join_with(Res, [?OP_L(", ")]), ?OP_L("]")].
+
+perl_call(Name, ArgsDesc, Values) ->
+    [?ID_L("XMLRPC::Lite"), ?OP_L("->"), ?ID_L("proxy"), ?OP_L("("), ?ID_L("$url"), ?OP_L(")->"),
+     ?ID_L("call"), ?OP_L("("), ?STR_A(Name), ?OP_L(", {"), ?BR, <<"  ">>,
+     list_join_with(lists:map(fun({A,B})->perl_gen(A, B, <<"  ">>) end, lists:zip(ArgsDesc, Values)), [?OP_L(","), ?BR, <<"  ">>]),
+     ?BR, ?OP_L("})->"), ?ID_L("results"), ?OP_L("()")].
+
+java_gen_map(Vals, Indent) ->
+    {Split, NL} = case Indent of
+                      none -> {<<" ">>, <<" ">>};
+                      _ -> {[?BR, <<"  ", Indent/binary>>], [?BR, Indent]}
+                  end,
+    [?KW_L("new "), ?ID_L("HashMap"), ?OP_L("<"), ?ID_L("String"), ?OP_L(", "), ?ID_L("Object"),
+     ?OP_L(">() {{"), Split, list_join_with(Vals, Split), NL, ?OP_L("}}")].
+
+java_gen({Name, integer}, Int, _Indent) ->
+    [?ID_L("put"), ?OP_L("("), ?STR_A(Name), ?OP_L(", "), ?KW_L("new "), ?ID_L("Integer"), ?OP_L("("), ?NUM(Int), ?OP_L("));")];
+java_gen({Name, string}, Str, _Indent) ->
+    [?ID_L("put"), ?OP_L("("), ?STR_A(Name), ?OP_L(", "), ?STR(Str), ?OP_L(");")];
+java_gen({Name, binary}, Str, _Indent) ->
+    [?ID_L("put"), ?OP_L("("), ?STR_A(Name), ?OP_L(", "), ?STR(Str), ?OP_L(");")];
+java_gen({Name, atom}, Atom, _Indent) ->
+    [?ID_L("put"), ?OP_L("("), ?STR_A(Name), ?OP_L(", "), ?STR(atom_to_list(Atom)), ?OP_L(");")];
+java_gen({Name, {tuple, Fields}}, Tuple, Indent) ->
+    NewIndent = <<"  ", Indent/binary>>,
+    Res = lists:map(fun({A, B}) -> [java_gen(A, B, NewIndent)] end, lists:zip(Fields, tuple_to_list(Tuple))),
+    [?ID_L("put"), ?OP_L("("), ?STR_A(Name), ?OP_L(", "), java_gen_map(Res, Indent), ?OP_L(")")];
+java_gen({Name, {list, ElDesc}}, List, Indent) ->
+    {NI, NI2, I} = case List of
+                    [_] -> {" ", " ", Indent};
+                    _ -> {[?BR, <<"    ", Indent/binary>>],
+                          [?BR, <<"  ", Indent/binary>>],
+                          <<"      ", Indent/binary>>}
+                end,
+    Res = lists:map(fun(E) -> java_gen_map([java_gen(ElDesc, E, I)], none) end, List),
+    [?ID_L("put"), ?OP_L("("), ?STR_A(Name), ?OP_L(", "), ?KW_L("new "), ?ID_L("Object"), ?OP_L("[] {"), NI,
+     list_join_with(Res, [?OP_L(","), NI]), NI2, ?OP_L("});")].
+
+java_call(Name, ArgsDesc, Values) ->
+    [?ID_L("XmlRpcClientConfigImpl config"), ?OP_L(" = "), ?KW_L("new "), ?ID_L("XmlRpcClientConfigImpl"), ?OP_L("();"), ?BR,
+     ?ID_L("config"), ?OP_L("."), ?ID_L("setServerURL"), ?OP_L("("), ?ID_L("url"), ?OP_L(");"), ?BR, ?BR,
+     ?ID_L("XmlRpcClient client"), ?OP_L(" = "), ?KW_L("new "), ?ID_L("XmlRpcClient"), ?OP_L("();"), ?BR,
+     ?ID_L("client"), ?OP_L("."), ?ID_L("setConfig"), ?OP_L("("), ?ID_L("config"), ?OP_L(");"), ?BR, ?BR,
+     ?ID_L("client"), ?OP_L("."), ?ID_L("execute"), ?OP_L("("), ?STR_A(Name), ?OP_L(", "),
+     java_gen_map(lists:map(fun({A,B})->java_gen(A, B, <<"">>) end, lists:zip(ArgsDesc, Values)), <<"">>), ?OP_L(");"), ?BR].
+
+-define(XML_S(N, V), ?OP_L("<"), ?FIELD_L(??N), ?OP_L(">"), V).
+-define(XML_E(N), ?OP_L("</"), ?FIELD_L(??N), ?OP_L(">")).
+-define(XML(N, Indent, V), ?BR, Indent, ?XML_S(N, V), ?BR, Indent, ?XML_E(N)).
+-define(XML(N, Indent, D, V), ?XML(N, [Indent, lists:duplicate(D, <<"  ">>)], V)).
+-define(XML_L(N, Indent, V), ?BR, Indent, ?XML_S(N, V), ?XML_E(N)).
+-define(XML_L(N, Indent, D, V), ?XML_L(N, [Indent, lists:duplicate(D, <<"  ">>)], V)).
+
+xml_gen({Name, integer}, Int, Indent) ->
+    [?XML(member, Indent,
+         [?XML_L(name, Indent, 1, ?ID_A(Name)),
+          ?XML(value, Indent, 1,
+               [?XML_L(integer, Indent, 2, ?ID(jlib:integer_to_binary(Int)))])])];
+xml_gen({Name, string}, Str, Indent) ->
+    [?XML(member, Indent,
+         [?XML_L(name, Indent, 1, ?ID_A(Name)),
+          ?XML(value, Indent, 1,
+               [?XML_L(string, Indent, 2, ?ID(Str))])])];
+xml_gen({Name, binary}, Str, Indent) ->
+    [?XML(member, Indent,
+         [?XML_L(name, Indent, 1, ?ID_A(Name)),
+          ?XML(value, Indent, 1,
+               [?XML_L(string, Indent, 2, ?ID(Str))])])];
+xml_gen({Name, atom}, Atom, Indent) ->
+    [?XML(member, Indent,
+         [?XML_L(name, Indent, 1, ?ID_A(Name)),
+          ?XML(value, Indent, 1,
+               [?XML_L(string, Indent, 2, ?ID(atom_to_list(Atom)))])])];
+xml_gen({Name, {tuple, Fields}}, Tuple, Indent) ->
+    NewIndent = <<"    ", Indent/binary>>,
+    Res = lists:map(fun({A, B}) -> xml_gen(A, B, NewIndent) end, lists:zip(Fields, tuple_to_list(Tuple))),
+    [?XML(member, Indent,
+         [?XML_L(name, Indent, 1, ?ID_A(Name)),
+          ?XML(value, Indent, 1, [?XML(struct, NewIndent, Res)])])];
+xml_gen({Name, {list, ElDesc}}, List, Indent) ->
+    Ind1 = <<"        ", Indent/binary>>,
+    Ind2 = <<"    ", Ind1/binary>>,
+    Res = lists:map(fun(E) -> [?XML(value, Ind1, [?XML(struct, Ind1, 1, xml_gen(ElDesc, E, Ind2))])] end, List),
+    [?XML(member, Indent,
+         [?XML_L(name, Indent, 1, ?ID_A(Name)),
+          ?XML(value, Indent, 1, [?XML(array, Indent, 2, [?XML(data, Indent, 3, Res)])])])].
+
+xml_call(Name, ArgsDesc, Values) ->
+    Ind = <<"">>,
+    Res = lists:map(fun({A, B}) -> xml_gen(A, B, <<"          ">>) end, lists:zip(ArgsDesc, Values)),
+    [?XML(methodCall, Ind,
+          [?XML_L(methodName, Ind, 1, ?ID_A(Name)),
+           ?XML(params, Ind, 1,
+                [?XML(param, Ind, 2,
+                      [?XML(value, Ind, 3,
+                            [?XML(struct, Ind, 4, Res)])])])])].
+
+generate_example_input({_Name, integer}, {LastStr, LastNum}) ->
+    {LastNum+1, {LastStr, LastNum+1}};
+generate_example_input({_Name, string}, {LastStr, LastNum}) ->
+    {string:chars(LastStr+1, 5), {LastStr+1, LastNum}};
+generate_example_input({_Name, binary}, {LastStr, LastNum}) ->
+    {iolist_to_binary(string:chars(LastStr+1, 5)), {LastStr+1, LastNum}};
+generate_example_input({_Name, atom}, {LastStr, LastNum}) ->
+    {list_to_atom(string:chars(LastStr+1, 5)), {LastStr+1, LastNum}};
+generate_example_input({_Name, {tuple, Fields}}, Data) ->
+    {R, D} = lists:foldl(fun(Field, {Res2, Data2}) ->
+                                 {Res3, Data3} = generate_example_input(Field, Data2),
+                                 {[Res3 | Res2], Data3}
+                         end, {[], Data}, Fields),
+    {list_to_tuple(lists:reverse(R)), D};
+generate_example_input({_Name, {list, Desc}}, Data) ->
+    {R1, D1} = generate_example_input(Desc, Data),
+    {R2, D2} = generate_example_input(Desc, D1),
+    {[R1, R2], D2}.
+
+
+gen_calls(#ejabberd_commands{args_example=none, args=ArgsDesc} = C) ->
+    {R, D} = lists:foldl(fun(Arg, {Res2, Data2}) ->
+                                 {Res3, Data3} = generate_example_input(Arg, Data2),
+                                 {[Res3 | Res2], Data3}
+                         end, {[], {$a-1, 0}}, ArgsDesc),
+    gen_calls(C#ejabberd_commands{args_example=lists:reverse(R)});
+gen_calls(#ejabberd_commands{args_example=Values, args=ArgsDesc, name=Name}) ->
+    Perl = perl_call(Name, ArgsDesc, Values),
+    Java = java_call(Name, ArgsDesc, Values),
+    XML = xml_call(Name, ArgsDesc, Values),
+    [?TAG(ul, "code-samples-names",
+          [?TAG(li, <<"Java">>),
+           ?TAG(li, <<"Perl">>),
+           ?TAG(li, <<"XML">>)]),
+     ?TAG(ul, "code-samples",
+          [?TAG(li, ?TAG(pre, Java)),
+           ?TAG(li, ?TAG(pre, Perl)),
+           ?TAG(li, ?TAG(pre, XML))])].
+
+gen_doc(#ejabberd_commands{name=Name, tags=Tags, desc=Desc, longdesc=LongDesc,
+                           args=Args, args_desc=ArgsDesc,
+                           result=Result, result_desc=ResultDesc}=Cmd) ->
+    LDesc = case LongDesc of
+                "" -> Desc;
+                _ -> LongDesc
+            end,
+    ArgsText = case ArgsDesc of
+                   none ->
+                       [?TAG(ul, "args-list", lists:map(fun({AName, Type}) ->
+                                                                [?TAG(li, [?TAG_R(strong, atom_to_list(AName)), <<" :: ">>,
+                                                                           ?RAW(io_lib:format("~p", [Type]))])]
+                                                        end, Args))];
+                   _ ->
+                       [?TAG(dl, "args-list", lists:map(fun({{AName, Type}, ADesc}) ->
+                                                                [?TAG(dt, [?TAG_R(strong, atom_to_list(AName)), <<" :: ">>,
+                                                                           ?RAW(io_lib:format("~p", [Type]))]),
+                                                                 ?TAG(dd, ?RAW(ADesc))]
+                                                        end, lists:zip(Args, ArgsDesc)))]
+               end,
+    ResultText = case ResultDesc of
+                     none ->
+                         [?RAW(io_lib:format("~p", [Result]))];
+                     _ ->
+                         [?RAW(io_lib:format("~p", [Result])),
+                          ?TAG_R(p, ResultDesc)]
+                 end,
+
+    [?TAG(h1, [?TAG(strong, atom_to_list(Name)), <<" - ">>, ?RAW(Desc)]),
+     ?TAG(p, ?RAW(LDesc)),
+     ?TAG(h2, <<"Arguments:">>),
+     ArgsText,
+     ?TAG(h2, <<"Result:">>),
+     ResultText,
+     ?TAG(h2, <<"Examples:">>),
+     gen_calls(Cmd)].
+
+generate_output(File, RegExp) ->
+    Cmds = lists:map(fun({N, _, _}) ->
+                             ejabberd_commands:get_command_definition(N)
+                     end, ejabberd_commands:list_commands()),
+    {ok, RE} = re:compile(RegExp),
+    Cmds2 = lists:filter(fun(#ejabberd_commands{name=Name, module=Module}) ->
+                                 re:run(atom_to_list(Name), RE, [{capture, none}]) == match orelse
+                                     re:run(atom_to_list(Module), RE, [{capture, none}]) == match
+                         end, Cmds),
+    Cmds3 = lists:sort(fun(#ejabberd_commands{name=N1}, #ejabberd_commands{name=N2}) ->
+                               N1 =< N2
+                       end, Cmds2),
+    Out = lists:map(fun(C) -> gen_doc(C) end, Cmds3),
+    {ok, Fh} = file:open(File, [write]),
+    io:format(Fh, "~s", [[html_pre(), Out, html_post()]]),
+    file:close(Fh),
+    ok.
+
+html_pre() ->
+    "<!DOCTYPE>
+<html>
+  <head>
+    <meta http-equiv='content-type' content='text/html; charset=utf-8' />
+  <style>
+    body {
+      margin: 0 auto;
+      font-family: Georgia, Palatino, serif;
+      color: #000;
+      line-height: 1;
+      max-width: 80%;
+      padding: 10px;
+    }
+    h1, h2, h3, h4 {
+      color: #111111;
+      font-weight: 400;
+    }
+    h1, h2, h3, h4, h5, p {
+      margin-bottom: 24px;
+      padding: 0;
+    }
+    h1 {
+      margin-top: 80px;
+      font-size: 36px;
+    }
+    h2 {
+      font-size: 24px;
+      margin: 24px 0 6px;
+    }
+    ul, ol {
+      padding: 0;
+      margin: 0;
+    }
+    li {
+      line-height: 24px;
+    }
+    li ul, li ul {
+      margin-left: 24px;
+    }
+    p, ul, ol {
+      font-size: 16px;
+      line-height: 24px;
+      max-width: 80%;
+    }
+    .id {color: #bbb}
+    .lit {color: #aaa}
+    .op {color: #9f9}
+    .str {color: #f00}
+    .num {color: white}
+    .field {color: #faa}
+    .kw {font-weight: bold; color: #ff6}
+    .code-samples li {
+      font-family: Consolas, Monaco, Andale Mono, monospace;
+      line-height: 1.5;
+      font-size: 13px;
+      background: #333;
+      overflow: auto;
+      margin: 0;
+      padding: 0;
+    }
+    .code-samples pre {
+      margin: 0;
+      padding: 0.5em 0.5em;
+    }
+    .code-samples {
+      position: relative;
+    }
+    .code-samples-names li {
+      display: block;
+    }
+    .code-samples-names li {
+      color: white;
+      background: #9c1;
+      float: left;
+      margin: 0 1px -4px 0;
+      position: relative;
+      z-index: 1;
+      border: 4px solid #9c1;
+      border-bottom: 0;
+      border-radius: 9px 9px 0 0;
+      padding: 0.2em 1em 4px 1em;
+      cursor: pointer;
+    }
+    .code-samples-names li.selected {
+      background: #333;
+    }
+    .code-samples {
+      clear: both;
+    }
+    .code-samples li {
+      display: block;
+      border: 4px solid #9c1;
+      border-radius: 9px;
+      border-top-left-radius: 0;
+      width: 100%;
+    }
+    .args-list li {
+      display: block;
+    }
+  </style>
+</head>
+  <body>
+    <script>
+      function changeTab2(tab, addClickHandlers) {
+        var els = tab.parentNode.childNodes;
+        var els2 = tab.parentNode.nextSibling.childNodes;
+        for (var i = 0; i < els.length; i++) {
+          if (addClickHandlers)
+            els[i].addEventListener('click', changeTab, false);
+
+          if (els[i] == tab) {
+            els[i].setAttribute('class', 'selected');
+            els2[i].style.display = 'block';
+          } else {
+            els[i].removeAttribute('class');
+            els2[i].style.display = 'none';
+          }
+        }
+      }
+      function changeTab(event) {
+        changeTab2(event.target);
+      }
+    </script>".
+
+html_post() ->
+"<script>
+    var ul = document.getElementsByTagName('ul');
+    for (var i = 0; i < ul.length; i++) {
+      if (ul[i].className == 'code-samples-names')
+        changeTab2(ul[i].firstChild, true);
+    }
+  </script>
+  </body>
+</html>".

src/ejabberd_config.erl

@@ -5,7 +5,7 @@
 %%% Created : 14 Dec 2002 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -29,9 +29,13 @@
 
 -export([start/0, load_file/1,
 	 add_global_option/2, add_local_option/2,
-	 get_global_option/1, get_local_option/1]).
+	 get_global_option/2, get_local_option/2,
+         get_global_option/3, get_local_option/3]).
 -export([get_vh_by_auth_method/1]).
 -export([is_file_readable/1]).
+-export([get_version/0, get_myhosts/0, get_mylang/0]).
+-export([prepare_opt_val/4]).
+-export([convert_table_to_binary/5]).
 
 -include("ejabberd.hrl").
 -include("ejabberd_config.hrl").
@@ -60,6 +64,14 @@ start() ->
     load_file(Config),
     %% This start time is used by mod_last:
     add_local_option(node_start, now()),
+    SharedKey = case erlang:get_cookie() of
+                    nocookie ->
+                        sha:sha(randoms:get_string());
+                    Cookie ->
+                        sha:sha(jlib:atom_to_binary(Cookie))
+                end,
+    add_local_option(shared_key, SharedKey),
+    add_local_option(flash_hack, ?FLASH_HACK),
     ok.
 
 %% @doc Get the filename of the ejabberd configuration file.
@@ -95,12 +107,15 @@ load_file(File) ->
 %% Returns a list of plain terms,
 %% in which the options 'include_config_file' were parsed
 %% and the terms in those files were included.
-%% @spec(string()) -> [term()]
+%% @spec(iolist()) -> [term()]
+get_plain_terms_file(File) when is_binary(File) ->
+    get_plain_terms_file(binary_to_list(File));
 get_plain_terms_file(File1) ->
     File = get_absolute_path(File1),
     case file:consult(File) of
 	{ok, Terms} ->
-	    include_config_files(Terms);
+            BinTerms = strings_to_binary(Terms),
+	    include_config_files(BinTerms);
 	{error, {LineNumber, erl_parse, _ParseMessage} = Reason} ->
 	    ExitText = describe_config_problem(File, Reason, LineNumber),
 	    ?ERROR_MSG(ExitText, []),
@@ -159,7 +174,7 @@ normalize_hosts(Hosts) ->
 normalize_hosts([], PrepHosts) ->
     lists:reverse(PrepHosts);
 normalize_hosts([Host|Hosts], PrepHosts) ->
-    case jlib:nodeprep(Host) of
+    case jlib:nodeprep(iolist_to_binary(Host)) of
 	error ->
 	    ?ERROR_MSG("Can't load config file: "
 		       "invalid host name [~p]", [Host]),
@@ -173,20 +188,18 @@ normalize_hosts([Host|Hosts], PrepHosts) ->
 %%% Errors reading the config file
 
 describe_config_problem(Filename, Reason) ->
-    Text1 = lists:flatten("Problem loading ejabberd config file " ++ Filename),
-    Text2 = lists:flatten(" : " ++ file:format_error(Reason)),
-    ExitText = Text1 ++ Text2,
-    ExitText.
+    ExitText = ["Problem loading ejabberd config file ", Filename,
+                ": ", file:format_error(Reason)],
+    binary_to_list(iolist_to_binary(ExitText)).
 
 describe_config_problem(Filename, Reason, LineNumber) ->
-    Text1 = lists:flatten("Problem loading ejabberd config file " ++ Filename),
-    Text2 = lists:flatten(" approximately in the line "
-			  ++ file:format_error(Reason)),
-    ExitText = Text1 ++ Text2,
+    ExitText =
+        ["Problem loading ejabberd config file ", Filename,
+         " approximately in the line ", file:format_error(Reason)],
     Lines = get_config_lines(Filename, LineNumber, 10, 3),
     ?ERROR_MSG("The following lines from your configuration file might be"
 	       " relevant to the error: ~n~s", [Lines]),
-    ExitText.
+    binary_to_list(iolist_to_binary(ExitText)).
 
 get_config_lines(Filename, TargetNumber, PreContext, PostContext) ->
     {ok, Fd} = file:open(Filename, [read]),
@@ -443,6 +456,14 @@ process_term(Term, State) ->
 	    State;
 	{max_fsm_queue, N} ->
 	    add_option(max_fsm_queue, N, State);
+        {hostname, Host} ->
+            add_option(hostname, Host, State);
+        {rehash_timeout, Secs} ->
+            add_option(rehash_timeout, Secs, State);
+        {migrate_timeout, Secs} ->
+            add_option(migrate_timeout, Secs, State);
+        {riak_server, ServerPort} ->
+            add_option(riak_server, ServerPort, State);
 	{_Opt, _Val} ->
 	    lists:foldl(fun(Host, S) -> process_host_term(Term, Host, S) end,
 			State, State#state.hosts)
@@ -564,7 +585,6 @@ set_opts(State) ->
 	    exit("Error reading Mnesia database")
     end.
 
-
 add_global_option(Opt, Val) ->
     mnesia:transaction(fun() ->
 			       mnesia:write(#config{key = Opt,
@@ -577,23 +597,63 @@ add_local_option(Opt, Val) ->
 							  value = Val})
 		       end).
 
+-spec prepare_opt_val(any(), any(), check_fun(), any()) -> any().
 
-get_global_option(Opt) ->
+prepare_opt_val(Opt, Val, F, Default) ->
+    Res = case F of
+              {Mod, Fun} ->
+                  catch Mod:Fun(Val);
+              _ ->
+                  catch F(Val)
+          end,
+    case Res of
+        {'EXIT', _} ->
+            ?INFO_MSG("Configuration problem:~n"
+                      "** Option: ~s~n"
+                      "** Invalid value: ~s~n"
+                      "** Using as fallback: ~s",
+                      [format_term(Opt),
+                       format_term(Val),
+                       format_term(Default)]),
+            Default;
+        _ ->
+            Res
+    end.
+
+-type check_fun() :: fun((any()) -> any()) | {module(), atom()}.
+
+-spec get_global_option(any(), check_fun()) -> any().
+
+get_global_option(Opt, F) ->
+    get_global_option(Opt, F, undefined).
+
+-spec get_global_option(any(), check_fun(), any()) -> any().
+
+get_global_option(Opt, F, Default) ->
     case ets:lookup(config, Opt) of
 	[#config{value = Val}] ->
-	    Val;
+	    prepare_opt_val(Opt, Val, F, Default);
 	_ ->
-	    undefined
+            Default
     end.
 
-get_local_option(Opt) ->
+-spec get_local_option(any(), check_fun()) -> any().
+
+get_local_option(Opt, F) ->
+    get_local_option(Opt, F, undefined).
+
+-spec get_local_option(any(), check_fun(), any()) -> any().
+
+get_local_option(Opt, F, Default) ->
     case ets:lookup(local_config, Opt) of
 	[#local_config{value = Val}] ->
-	    Val;
+	    prepare_opt_val(Opt, Val, F, Default);
 	_ ->
-	    undefined
+	    Default
     end.
 
+-spec get_vh_by_auth_method(atom()) -> [binary()].
+
 %% Return the list of hosts handled by a given module
 get_vh_by_auth_method(AuthMethod) ->
     mnesia:dirty_select(local_config,
@@ -613,8 +673,25 @@ is_file_readable(Path) ->
 	    false
     end.
 
+get_version() ->
+    list_to_binary(element(2, application:get_key(ejabberd, vsn))).
+
+-spec get_myhosts() -> [binary()].
+
+get_myhosts() ->
+    ejabberd_config:get_global_option(hosts, fun(V) -> V end).
+
+-spec get_mylang() -> binary().
+
+get_mylang() ->
+    ejabberd_config:get_global_option(
+      language,
+      fun iolist_to_binary/1,
+      <<"en">>).
+
 replace_module(mod_announce_odbc) -> {mod_announce, odbc};
 replace_module(mod_blocking_odbc) -> {mod_blocking, odbc};
+replace_module(mod_caps_odbc) -> {mod_caps, odbc};
 replace_module(mod_irc_odbc) -> {mod_irc, odbc};
 replace_module(mod_last_odbc) -> {mod_last, odbc};
 replace_module(mod_muc_odbc) -> {mod_muc, odbc};
@@ -632,10 +709,161 @@ replace_modules(Modules) ->
       fun({Module, Opts}) ->
               case replace_module(Module) of
                   {NewModule, DBType} ->
+                      emit_deprecation_warning(Module, NewModule, DBType),
                       NewOpts = [{db_type, DBType} |
                                  lists:keydelete(db_type, 1, Opts)],
                       {NewModule, NewOpts};
                   NewModule ->
+                      if Module /= NewModule ->
+                              emit_deprecation_warning(Module, NewModule);
+                         true ->
+                              ok
+                      end,
                       {NewModule, Opts}
               end
       end, Modules).
+
+strings_to_binary([]) ->
+    [];
+strings_to_binary(L) when is_list(L) ->
+    case is_string(L) of
+        true ->
+            list_to_binary(L);
+        false ->
+            strings_to_binary1(L)
+    end;
+strings_to_binary(T) when is_tuple(T) ->
+    list_to_tuple(strings_to_binary(tuple_to_list(T)));
+strings_to_binary(X) ->
+    X.
+
+strings_to_binary1([El|L]) ->
+    [strings_to_binary(El)|strings_to_binary1(L)];
+strings_to_binary1([]) ->
+    [];
+strings_to_binary1(T) ->
+    T.
+
+is_string([C|T]) when (C >= 0) and (C =< 255) ->
+    is_string(T);
+is_string([]) ->
+    true;
+is_string(_) ->
+    false.
+
+binary_to_strings(B) when is_binary(B) ->
+    binary_to_list(B);
+binary_to_strings([H|T]) ->
+    [binary_to_strings(H)|binary_to_strings(T)];
+binary_to_strings(T) when is_tuple(T) ->
+    list_to_tuple(binary_to_strings(tuple_to_list(T)));
+binary_to_strings(T) ->
+    T.
+
+format_term(Bin) when is_binary(Bin) ->
+    io_lib:format("\"~s\"", [Bin]);
+format_term(S) when is_list(S), S /= [] ->
+    case lists:all(fun(C) -> (C>=0) and (C=<255) end, S) of
+        true ->
+            io_lib:format("\"~s\"", [S]);
+        false ->
+            io_lib:format("~p", [binary_to_strings(S)])
+    end;
+format_term(T) ->
+    io_lib:format("~p", [binary_to_strings(T)]).
+
+-spec convert_table_to_binary(atom(), [atom()], atom(),
+                              fun(), fun()) -> ok.
+
+convert_table_to_binary(Tab, Fields, Type, DetectFun, ConvertFun) ->
+    case is_table_still_list(Tab, DetectFun) of
+        true ->
+            ?INFO_MSG("Converting '~s' table from strings to binaries.", [Tab]),
+            TmpTab = list_to_atom(atom_to_list(Tab) ++ "_tmp_table"),
+            catch mnesia:delete_table(TmpTab),
+            case mnesia:create_table(TmpTab,
+                                     [{disc_only_copies, [node()]},
+                                      {type, Type},
+                                      {local_content, true},
+                                      {record_name, Tab},
+                                      {attributes, Fields}]) of
+                {atomic, ok} ->
+                    mnesia:transform_table(Tab, ignore, Fields),
+                    case mnesia:transaction(
+                           fun() ->
+                                   mnesia:write_lock_table(TmpTab),
+                                   mnesia:foldl(
+                                     fun(R, _) ->
+                                             NewR = ConvertFun(R),
+                                             mnesia:dirty_write(TmpTab, NewR)
+                                     end, ok, Tab)
+                           end) of
+                        {atomic, ok} ->
+                            mnesia:clear_table(Tab),
+                            case mnesia:transaction(
+                                   fun() ->
+                                           mnesia:write_lock_table(Tab),
+                                           mnesia:foldl(
+                                             fun(R, _) ->
+                                                     mnesia:dirty_write(R)
+                                             end, ok, TmpTab)
+                                   end) of
+                                {atomic, ok} ->
+                                    mnesia:delete_table(TmpTab);
+                                Err ->
+                                    report_and_stop(Tab, Err)
+                            end;
+                        Err ->
+                            report_and_stop(Tab, Err)
+                    end;
+                Err ->
+                    report_and_stop(Tab, Err)
+            end;
+        false ->
+            ok
+    end.
+
+is_table_still_list(Tab, DetectFun) ->
+    is_table_still_list(Tab, DetectFun, mnesia:dirty_first(Tab)).
+
+is_table_still_list(_Tab, _DetectFun, '$end_of_table') ->
+    false;
+is_table_still_list(Tab, DetectFun, Key) ->
+    Rs = mnesia:dirty_read(Tab, Key),
+    Res = lists:foldl(fun(_, true) ->
+                              true;
+                         (_, false) ->
+                              false;
+                         (R, _) ->
+                              case DetectFun(R) of
+                                  '$next' ->
+                                      '$next';
+                                  El ->
+                                      is_list(El)
+                              end
+                      end, '$next', Rs),
+    case Res of
+        true ->
+            true;
+        false ->
+            false;
+        '$next' ->
+            is_table_still_list(Tab, DetectFun, mnesia:dirty_next(Tab, Key))
+    end.
+
+report_and_stop(Tab, Err) ->
+    ErrTxt = lists:flatten(
+               io_lib:format(
+                 "Failed to convert '~s' table to binary: ~p",
+                 [Tab, Err])),
+    ?CRITICAL_MSG(ErrTxt, []),
+    timer:sleep(1000),
+    halt(string:substr(ErrTxt, 1, 199)).
+
+emit_deprecation_warning(Module, NewModule, DBType) ->
+    ?WARNING_MSG("Module ~s is deprecated, use {~s, [{db_type, ~s}, ...]}"
+                 " instead", [Module, NewModule, DBType]).
+
+emit_deprecation_warning(Module, NewModule) ->
+    ?WARNING_MSG("Module ~s is deprecated, use ~s instead",
+                 [Module, NewModule]).

src/ejabberd_config.hrl

@@ -1,6 +1,6 @@
 %%%----------------------------------------------------------------------
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -19,10 +19,16 @@
 %%%
 %%%----------------------------------------------------------------------
 
--record(config, {key, value}).
--record(local_config, {key, value}).
--record(state, {opts = [],
-		hosts = [],
-		override_local = false,
-		override_global = false,
-		override_acls = false}).
+-record(config, {key :: any(), value :: any()}).
+
+-record(local_config, {key :: any(), value :: any()}).
+
+-type config() :: #config{}.
+-type local_config() :: #local_config{}.
+
+-record(state,
+	{opts = []               :: [acl:acl() | config() | local_config()],
+         hosts = []              :: [binary()],
+         override_local = false  :: boolean(),
+	 override_global = false :: boolean(),
+         override_acls = false   :: boolean()}).

src/ejabberd_ctl.erl

@@ -5,7 +5,7 @@
 %%% Created : 11 Jan 2004 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -72,10 +72,10 @@ start() ->
 			 _ ->
 			     case net_kernel:longnames() of
 				 true ->
-				     SNode ++ "@" ++ inet_db:gethostname() ++
-					 "." ++ inet_db:res_option(domain);
+				     lists:flatten([SNode, "@", inet_db:gethostname(),
+                                                    ".", inet_db:res_option(domain)]);
 				 false ->
-				     SNode ++ "@" ++ inet_db:gethostname();
+                                     lists:flatten([SNode, "@", inet_db:gethostname()]);
 				 _ ->
 				     SNode
 			     end
@@ -124,6 +124,8 @@ unregister_commands(CmdDescs, Module, Function) ->
 %% Process
 %%-----------------------------
 
+-spec process([string()]) -> non_neg_integer().
+
 %% The commands status, stop and restart are defined here to ensure
 %% they are usable even if ejabberd is completely stopped.
 process(["status"]) ->
@@ -159,7 +161,7 @@ process(["mnesia", "info"]) ->
     mnesia:info(),
     ?STATUS_SUCCESS;
 
-process(["mnesia", Arg]) when is_list(Arg) ->
+process(["mnesia", Arg]) ->
     case catch mnesia:system_info(list_to_atom(Arg)) of
 	{'EXIT', Error} -> ?PRINT("Error: ~p~n", [Error]);
 	Return -> ?PRINT("~p~n", [Return])
@@ -190,8 +192,9 @@ process(["help" | Mode]) ->
 	    print_usage_help(MaxC, ShCode),
 	    ?STATUS_SUCCESS;
 	[CmdString | _] ->
-	    CmdStringU = ejabberd_regexp:greplace(CmdString, "-", "_"),
-	    print_usage_commands(CmdStringU, MaxC, ShCode),
+	    CmdStringU = ejabberd_regexp:greplace(
+                           list_to_binary(CmdString), <<"-">>, <<"_">>),
+	    print_usage_commands(binary_to_list(CmdStringU), MaxC, ShCode),
 	    ?STATUS_SUCCESS
     end;
 
@@ -214,30 +217,27 @@ process2(Args, AccessCommands) ->
 process2(Args, Auth, AccessCommands) ->
     case try_run_ctp(Args, Auth, AccessCommands) of
 	{String, wrong_command_arguments}
-	when is_list(String) ->
+          when is_list(String) ->
 	    io:format(lists:flatten(["\n" | String]++["\n"])),
 	    [CommandString | _] = Args,
             process(["help" | [CommandString]]),
 	    {lists:flatten(String), ?STATUS_ERROR};
 	{String, Code}
-	when is_list(String) and is_integer(Code) ->
+          when is_list(String) and is_integer(Code) ->
 	    {lists:flatten(String), Code};
 	String
-	when is_list(String) ->
+          when is_list(String) ->
 	    {lists:flatten(String), ?STATUS_SUCCESS};
 	Code
-	when is_integer(Code) ->
+          when is_integer(Code) ->
 	    {"", Code};
 	Other ->
 	    {"Erroneous result: " ++ io_lib:format("~p", [Other]), ?STATUS_ERROR}
     end.
 
 get_accesscommands() ->
-    case ejabberd_config:get_local_option(ejabberdctl_access_commands) of
-	ACs when is_list(ACs) -> ACs;
-	_ -> []
-    end.
-
+    ejabberd_config:get_local_option(ejabberdctl_access_commands,
+                                     fun(V) when is_list(V) -> V end, []).
 
 %%-----------------------------
 %% Command calling
@@ -281,8 +281,9 @@ try_call_command(Args, Auth, AccessCommands) ->
 
 %% @spec (Args::[string()], Auth, AccessCommands) -> string() | integer() | {string(), integer()} | {error, ErrorType}
 call_command([CmdString | Args], Auth, AccessCommands) ->
-    CmdStringU = ejabberd_regexp:greplace(CmdString, "-", "_"),
-    Command = list_to_atom(CmdStringU),
+    CmdStringU = ejabberd_regexp:greplace(
+                   list_to_binary(CmdString), <<"-">>, <<"_">>),
+    Command = list_to_atom(binary_to_list(CmdStringU)),
     case ejabberd_commands:get_command_format(Command) of
 	{error, command_unknown} ->
 	    {error, command_unknown};
@@ -292,7 +293,7 @@ call_command([CmdString | Args], Auth, AccessCommands) ->
 		    Result = ejabberd_commands:execute_command(AccessCommands, Auth, Command,
 							       ArgsFormatted),
 		    format_result(Result, ResultFormat);
-		{'EXIT', {function_clause,[{lists,zip,[A1, A2]} | _]}} ->
+		{'EXIT', {function_clause,[{lists,zip,[A1, A2], _} | _]}} ->
 		    {NumCompa, TextCompa} =
 			case {length(A1), length(A2)} of
 			    {L1, L2} when L1 < L2 -> {L2-L1, "less argument"};
@@ -320,10 +321,12 @@ format_args(Args, ArgsFormat) ->
 
 format_arg(Arg, integer) ->
     format_arg2(Arg, "~d");
+format_arg(Arg, binary) ->
+    list_to_binary(format_arg(Arg, string));
 format_arg("", string) ->
     "";
 format_arg(Arg, string) ->
-    NumChars = integer_to_list(string:len(Arg)),
+    NumChars = integer_to_list(length(Arg)),
     Parse = "~" ++ NumChars ++ "c",
     format_arg2(Arg, Parse).
 
@@ -344,9 +347,12 @@ format_result(Atom, {_Name, atom}) ->
 format_result(Int, {_Name, integer}) ->
     io_lib:format("~p", [Int]);
 
-format_result(String, {_Name, string}) ->
+format_result(String, {_Name, string}) when is_list(String) ->
     io_lib:format("~s", [String]);
 
+format_result(Binary, {_Name, string}) when is_binary(Binary) ->
+    io_lib:format("~s", [binary_to_list(Binary)]);
+
 format_result(Code, {_Name, rescode}) ->
     make_status(Code);
 
@@ -529,24 +535,25 @@ split_desc_segments(MaxL, Words) ->
 join(L, Words) ->
     join(L, Words, 0, [], []).
 
-join(_L, [], _LenLastSeg, LastSeg, ResSeg) ->
-    ResSeg2 = [lists:reverse(LastSeg) | ResSeg],
-    lists:reverse(ResSeg2);
-join(L, [Word | Words], LenLastSeg, LastSeg, ResSeg) ->
-    LWord = length(Word),
-    case LWord + LenLastSeg < L of
-	true ->
-	    %% This word fits in the last segment
-	    %% If this word ends with "\n", reset column counter
-	    case string:str(Word, "\n") of
-		0 ->
-		    join(L, Words, LenLastSeg+LWord+1, [" ", Word | LastSeg], ResSeg);
-		_ ->
-		    join(L, Words, LWord+1, [" ", Word | LastSeg], ResSeg)
-	    end;
-	false ->
-	    join(L, Words, LWord, [" ", Word], [lists:reverse(LastSeg) | ResSeg])
-    end.
+join(_Len, [], _CurSegLen, CurSeg, AllSegs) ->
+    lists:reverse([CurSeg | AllSegs]);
+join(Len, [Word | Tail], CurSegLen, CurSeg, AllSegs) ->
+    WordLen = length(Word),
+    SegSize = WordLen + CurSegLen + 1,
+    {NewCurSeg, NewAllSegs, NewCurSegLen} =
+        if SegSize < Len ->
+                {[CurSeg, " ", Word], AllSegs, SegSize};
+           true ->
+                {Word, [CurSeg | AllSegs], WordLen}
+        end,
+    NewLen = case string:str(Word, "\n") of
+                 0 ->
+                     NewCurSegLen;
+                 _ ->
+                     0
+             end,
+    join(Len, Tail, NewLen, NewCurSeg, NewAllSegs).
+
 
 format_command_lines(CALD, MaxCmdLen, MaxC, ShCode, dual)
   when MaxC - MaxCmdLen < 40 ->
@@ -557,7 +564,8 @@ format_command_lines(CALD, MaxCmdLen, MaxC, ShCode, dual) ->
     lists:map(
       fun({Cmd, Args, CmdArgsL, Desc}) ->
 	      DescFmt = prepare_description(MaxCmdLen+4, MaxC, Desc),
-	      ["  ", ?B(Cmd), " ", [[?U(Arg), " "] || Arg <- Args], string:chars($\s, MaxCmdLen - CmdArgsL + 1),
+	      ["  ", ?B(Cmd), " ", [[?U(Arg), " "] || Arg <- Args],
+               string:chars($\s, MaxCmdLen - CmdArgsL + 1),
 	       DescFmt, "\n"]
       end, CALD);
 
@@ -597,7 +605,8 @@ print_usage_tags(Tag, MaxC, ShCode) ->
 		    end,
     CommandsList = lists:map(
 		     fun(NameString) ->
-			     C = ejabberd_commands:get_command_definition(list_to_atom(NameString)),
+			     C = ejabberd_commands:get_command_definition(
+                                   list_to_atom(NameString)),
 			     #ejabberd_commands{name = Name,
 						args = Args,
 						desc = Desc} = C,
@@ -678,10 +687,10 @@ filter_commands(All, SubString) ->
     end.
 
 filter_commands_regexp(All, Glob) ->
-    RegExp = ejabberd_regexp:sh_to_awk(Glob),
+    RegExp = ejabberd_regexp:sh_to_awk(list_to_binary(Glob)),
     lists:filter(
       fun(Command) ->
-	      case ejabberd_regexp:run(Command, RegExp) of
+	      case ejabberd_regexp:run(list_to_binary(Command), RegExp) of
 		  match ->
 		      true;
 		  nomatch ->
@@ -742,11 +751,11 @@ print_usage_command(Cmd, C, MaxC, ShCode) ->
     ?PRINT(["\n", NameFmt, "\n", ArgsFmt, "\n", ReturnsFmt, "\n\n", XmlrpcFmt, TagsFmt, "\n\n", DescFmt, "\n\n", LongDescFmt, NoteEjabberdctl], []).
 
 format_usage_ctype(Type, _Indentation)
-  when (Type==atom) or (Type==integer) or (Type==string) or (Type==rescode) or (Type==restuple)->
+  when (Type==atom) or (Type==integer) or (Type==string) or (Type==binary) or (Type==rescode) or (Type==restuple)->
     io_lib:format("~p", [Type]);
 
 format_usage_ctype({Name, Type}, _Indentation)
-  when (Type==atom) or (Type==integer) or (Type==string) or (Type==rescode) or (Type==restuple)->
+  when (Type==atom) or (Type==integer) or (Type==string) or (Type==binary) or (Type==rescode) or (Type==restuple)->
     io_lib:format("~p::~p", [Name, Type]);
 
 format_usage_ctype({Name, {list, ElementDef}}, Indentation) ->

src/ejabberd_ctl.hrl

@@ -1,6 +1,6 @@
 %%%----------------------------------------------------------------------
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -20,6 +20,9 @@
 %%%----------------------------------------------------------------------
 
 -define(STATUS_SUCCESS, 0).
--define(STATUS_ERROR,   1).
--define(STATUS_USAGE,   2).
--define(STATUS_BADRPC,  3).
+
+-define(STATUS_ERROR, 1).
+
+-define(STATUS_USAGE, 2).
+
+-define(STATUS_BADRPC, 3).

src/ejabberd_frontend_socket.erl

@@ -5,7 +5,7 @@
 %%% Created : 23 Aug 2006 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,91 +25,72 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_frontend_socket).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
 
 %% API
--export([start/4,
-	 start_link/5,
-	 %connect/3,
-	 starttls/2,
-	 starttls/3,
-	 compress/1,
-	 compress/2,
-	 reset_stream/1,
-	 send/2,
-	 change_shaper/2,
-	 monitor/1,
-	 get_sockmod/1,
-	 get_peer_certificate/1,
-	 get_verify_result/1,
-	 close/1,
-	 sockname/1, peername/1]).
+-export([start/4, start_link/5, starttls/2, starttls/3,
+	 compress/1, compress/2, reset_stream/1, send/2,
+	 change_shaper/2, monitor/1, get_sockmod/1,
+	 get_peer_certificate/1, get_verify_result/1, close/1,
+	 setopts/2, change_controller/2, sockname/1,
+	 peername/1]).
+
+         %connect/3,
 
 %% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
-	 terminate/2, code_change/3]).
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, terminate/2, code_change/3]).
 
--record(state, {sockmod, socket, receiver}).
+-record(socket_state, {sockmod, socket, receiver}).
 
 -define(HIBERNATE_TIMEOUT, 90000).
 
-%%====================================================================
-%% API
-%%====================================================================
-%%--------------------------------------------------------------------
-%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
-%% Description: Starts the server
-%%--------------------------------------------------------------------
 start_link(Module, SockMod, Socket, Opts, Receiver) ->
     gen_server:start_link(?MODULE,
 			  [Module, SockMod, Socket, Opts, Receiver], []).
 
 start(Module, SockMod, Socket, Opts) ->
     case Module:socket_type() of
-	xml_stream ->
-	    MaxStanzaSize =
-		case lists:keysearch(max_stanza_size, 1, Opts) of
-		    {value, {_, Size}} -> Size;
-		    _ -> infinity
-		end,
-	    Receiver = ejabberd_receiver:start(Socket, SockMod, none, MaxStanzaSize),
-	    case SockMod:controlling_process(Socket, Receiver) of
-		ok ->
-		    ok;
-		{error, _Reason} ->
-		    SockMod:close(Socket)
-	    end,
-	    supervisor:start_child(ejabberd_frontend_socket_sup,
-				   [Module, SockMod, Socket, Opts, Receiver]);
-	raw ->
-	    %{ok, Pid} = Module:start({SockMod, Socket}, Opts),
-	    %case SockMod:controlling_process(Socket, Pid) of
-	    %    ok ->
-	    %        ok;
-	    %    {error, _Reason} ->
-	    %        SockMod:close(Socket)
-	    %end
-	    todo
+      xml_stream ->
+	  MaxStanzaSize = case lists:keysearch(max_stanza_size, 1,
+					       Opts)
+			      of
+			    {value, {_, Size}} -> Size;
+			    _ -> infinity
+			  end,
+	  Receiver = ejabberd_receiver:start(Socket, SockMod,
+					     none, MaxStanzaSize),
+	  case SockMod:controlling_process(Socket, Receiver) of
+	    ok -> ok;
+	    {error, _Reason} -> SockMod:close(Socket)
+	  end,
+	  supervisor:start_child(ejabberd_frontend_socket_sup,
+				 [Module, SockMod, Socket, Opts, Receiver]);
+      raw ->
+	  %{ok, Pid} = Module:start({SockMod, Socket}, Opts),
+	  %case SockMod:controlling_process(Socket, Pid) of
+	  %    ok ->
+	  %        ok;
+	  %    {error, _Reason} ->
+	  %        SockMod:close(Socket)
+	  %end
+	  todo
     end.
 
-starttls(FsmRef, _TLSOpts) ->
-    %% TODO: Frontend improvements planned by Aleksey
-    %%gen_server:call(FsmRef, {starttls, TLSOpts}),
-    FsmRef.
+starttls(FsmRef, TLSOpts) ->
+    starttls(FsmRef, TLSOpts, undefined).
 
 starttls(FsmRef, TLSOpts, Data) ->
     gen_server:call(FsmRef, {starttls, TLSOpts, Data}),
     FsmRef.
 
-compress(FsmRef) ->
-    gen_server:call(FsmRef, compress),
-    FsmRef.
+compress(FsmRef) -> compress(FsmRef, undefined).
 
 compress(FsmRef, Data) ->
-    gen_server:call(FsmRef, {compress, Data}),
-    FsmRef.
+    gen_server:call(FsmRef, {compress, Data}), FsmRef.
 
 reset_stream(FsmRef) ->
     gen_server:call(FsmRef, reset_stream).
@@ -120,8 +101,7 @@ send(FsmRef, Data) ->
 change_shaper(FsmRef, Shaper) ->
     gen_server:call(FsmRef, {change_shaper, Shaper}).
 
-monitor(FsmRef) ->
-    erlang:monitor(process, FsmRef).
+monitor(FsmRef) -> erlang:monitor(process, FsmRef).
 
 get_sockmod(FsmRef) ->
     gen_server:call(FsmRef, get_sockmod).
@@ -132,196 +112,130 @@ get_peer_certificate(FsmRef) ->
 get_verify_result(FsmRef) ->
     gen_server:call(FsmRef, get_verify_result).
 
-close(FsmRef) ->
-    gen_server:call(FsmRef, close).
+close(FsmRef) -> gen_server:call(FsmRef, close).
 
-sockname(FsmRef) ->
-    gen_server:call(FsmRef, sockname).
+sockname(FsmRef) -> gen_server:call(FsmRef, sockname).
 
-peername(_FsmRef) ->
-    %% TODO: Frontend improvements planned by Aleksey
-    %%gen_server:call(FsmRef, peername).
-    {ok, {{0, 0, 0, 0}, 0}}.
+setopts(FsmRef, Opts) ->
+    gen_server:call(FsmRef, {setopts, Opts}).
 
+change_controller(FsmRef, C2SPid) ->
+    gen_server:call(FsmRef, {change_controller, C2SPid}).
+
+peername(FsmRef) -> gen_server:call(FsmRef, peername).
 
 %%====================================================================
 %% gen_server callbacks
 %%====================================================================
 
-%%--------------------------------------------------------------------
-%% Function: init(Args) -> {ok, State} |
-%%                         {ok, State, Timeout} |
-%%                         ignore               |
-%%                         {stop, Reason}
-%% Description: Initiates the server
-%%--------------------------------------------------------------------
 init([Module, SockMod, Socket, Opts, Receiver]) ->
-    %% TODO: monitor the receiver
     Node = ejabberd_node_groups:get_closest_node(backend),
-    {SockMod2, Socket2} = check_starttls(SockMod, Socket, Receiver, Opts),
-    {ok, Pid} =
-	rpc:call(Node, Module, start, [{?MODULE, self()}, Opts]),
+    IP = case peername(SockMod, Socket) of
+	   {ok, IP1} -> IP1;
+	   _ -> undefined
+	 end,
+    {SockMod2, Socket2} = check_starttls(SockMod, Socket,
+					 Receiver, Opts),
+    {ok, Pid} = rpc:call(Node, Module, start,
+			 [{?MODULE, self()}, [{frontend_ip, IP} | Opts]]),
     ejabberd_receiver:become_controller(Receiver, Pid),
-    {ok, #state{sockmod = SockMod2,
-		socket = Socket2,
-		receiver = Receiver}}.
-
-%%--------------------------------------------------------------------
-%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
-%%                                      {reply, Reply, State, Timeout} |
-%%                                      {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, Reply, State} |
-%%                                      {stop, Reason, State}
-%% Description: Handling call messages
-%%--------------------------------------------------------------------
-handle_call({starttls, TLSOpts}, _From, State) ->
-    {ok, TLSSocket} = tls:tcp_to_tls(State#state.socket, TLSOpts),
-    ejabberd_receiver:starttls(State#state.receiver, TLSSocket),
-    Reply = ok,
-    {reply, Reply, State#state{socket = TLSSocket, sockmod = tls},
-     ?HIBERNATE_TIMEOUT};
+    {ok,
+     #socket_state{sockmod = SockMod2, socket = Socket2,
+	    receiver = Receiver}}.
 
 handle_call({starttls, TLSOpts, Data}, _From, State) ->
-    {ok, TLSSocket} = tls:tcp_to_tls(State#state.socket, TLSOpts),
-    ejabberd_receiver:starttls(State#state.receiver, TLSSocket),
-    catch (State#state.sockmod):send(
-	    State#state.socket, Data),
+    {ok, TLSSocket} =
+	ejabberd_receiver:starttls(State#socket_state.receiver,
+				   TLSOpts, Data),
     Reply = ok,
-    {reply, Reply, State#state{socket = TLSSocket, sockmod = tls},
+    {reply, Reply,
+     State#socket_state{socket = TLSSocket, sockmod = tls},
      ?HIBERNATE_TIMEOUT};
-
-handle_call(compress, _From, State) ->
-    {ok, ZlibSocket} = ejabberd_zlib:enable_zlib(
-			 State#state.sockmod,
-			 State#state.socket),
-    ejabberd_receiver:compress(State#state.receiver, ZlibSocket),
-    Reply = ok,
-    {reply, Reply, State#state{socket = ZlibSocket, sockmod = ejabberd_zlib},
-     ?HIBERNATE_TIMEOUT};
-
 handle_call({compress, Data}, _From, State) ->
-    {ok, ZlibSocket} = ejabberd_zlib:enable_zlib(
-			 State#state.sockmod,
-			 State#state.socket),
-    ejabberd_receiver:compress(State#state.receiver, ZlibSocket),
-    catch (State#state.sockmod):send(
-	    State#state.socket, Data),
+    {ok, ZlibSocket} =
+	ejabberd_receiver:compress(State#socket_state.receiver, Data),
     Reply = ok,
-    {reply, Reply, State#state{socket = ZlibSocket, sockmod = ejabberd_zlib},
+    {reply, Reply,
+     State#socket_state{socket = ZlibSocket,
+		 sockmod = ejabberd_zlib},
      ?HIBERNATE_TIMEOUT};
-
 handle_call(reset_stream, _From, State) ->
-    ejabberd_receiver:reset_stream(State#state.receiver),
+    ejabberd_receiver:reset_stream(State#socket_state.receiver),
     Reply = ok,
     {reply, Reply, State, ?HIBERNATE_TIMEOUT};
-
 handle_call({send, Data}, _From, State) ->
-    catch (State#state.sockmod):send(
-	    State#state.socket, Data),
+    catch (State#socket_state.sockmod):send(State#socket_state.socket,
+				     Data),
     Reply = ok,
     {reply, Reply, State, ?HIBERNATE_TIMEOUT};
-
 handle_call({change_shaper, Shaper}, _From, State) ->
-    ejabberd_receiver:change_shaper(State#state.receiver, Shaper),
+    ejabberd_receiver:change_shaper(State#socket_state.receiver,
+				    Shaper),
     Reply = ok,
     {reply, Reply, State, ?HIBERNATE_TIMEOUT};
-
 handle_call(get_sockmod, _From, State) ->
-    Reply = State#state.sockmod,
+    Reply = State#socket_state.sockmod,
     {reply, Reply, State, ?HIBERNATE_TIMEOUT};
-
 handle_call(get_peer_certificate, _From, State) ->
-    Reply = tls:get_peer_certificate(State#state.socket),
+    Reply = tls:get_peer_certificate(State#socket_state.socket),
     {reply, Reply, State, ?HIBERNATE_TIMEOUT};
-
 handle_call(get_verify_result, _From, State) ->
-    Reply = tls:get_verify_result(State#state.socket),
+    Reply = tls:get_verify_result(State#socket_state.socket),
     {reply, Reply, State, ?HIBERNATE_TIMEOUT};
-
 handle_call(close, _From, State) ->
-    ejabberd_receiver:close(State#state.receiver),
+    ejabberd_receiver:close(State#socket_state.receiver),
     Reply = ok,
     {stop, normal, Reply, State};
-
 handle_call(sockname, _From, State) ->
-    #state{sockmod = SockMod, socket = Socket} = State,
-    Reply =
-	case SockMod of
-	    gen_tcp ->
-		inet:sockname(Socket);
-	    _ ->
-		SockMod:sockname(Socket)
-	end,
+    #socket_state{sockmod = SockMod, socket = Socket} = State,
+    Reply = peername(SockMod, Socket),
     {reply, Reply, State, ?HIBERNATE_TIMEOUT};
-
 handle_call(peername, _From, State) ->
-    #state{sockmod = SockMod, socket = Socket} = State,
-    Reply =
-	case SockMod of
-	    gen_tcp ->
-		inet:peername(Socket);
-	    _ ->
-		SockMod:peername(Socket)
-	end,
+    #socket_state{sockmod = SockMod, socket = Socket} = State,
+    Reply = case SockMod of
+	      gen_tcp -> inet:peername(Socket);
+	      _ -> SockMod:peername(Socket)
+	    end,
     {reply, Reply, State, ?HIBERNATE_TIMEOUT};
-
+handle_call({setopts, Opts}, _From, State) ->
+    ejabberd_receiver:setopts(State#socket_state.receiver, Opts),
+    {reply, ok, State, ?HIBERNATE_TIMEOUT};
+handle_call({change_controller, Pid}, _From, State) ->
+    ejabberd_receiver:change_controller(State#socket_state.receiver,
+					Pid),
+    {reply, ok, State, ?HIBERNATE_TIMEOUT};
 handle_call(_Request, _From, State) ->
-    Reply = ok,
-    {reply, Reply, State, ?HIBERNATE_TIMEOUT}.
+    Reply = ok, {reply, Reply, State, ?HIBERNATE_TIMEOUT}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, State}
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
 handle_cast(_Msg, State) ->
     {noreply, State, ?HIBERNATE_TIMEOUT}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%%                                       {noreply, State, Timeout} |
-%%                                       {stop, Reason, State}
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
 handle_info(timeout, State) ->
-    proc_lib:hibernate(gen_server, enter_loop, [?MODULE, [], State]),
+    proc_lib:hibernate(gen_server, enter_loop,
+		       [?MODULE, [], State]),
     {noreply, State, ?HIBERNATE_TIMEOUT};
 handle_info(_Info, State) ->
     {noreply, State, ?HIBERNATE_TIMEOUT}.
 
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> void()
-%% Description: This function is called by a gen_server when it is about to
-%% terminate. It should be the opposite of Module:init/1 and do any necessary
-%% cleaning up. When it returns, the gen_server terminates with Reason.
-%% The return value is ignored.
-%%--------------------------------------------------------------------
-terminate(_Reason, _State) ->
-    ok.
+terminate(_Reason, _State) -> ok.
 
-%%--------------------------------------------------------------------
-%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
-    {ok, State}.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
 
-%%--------------------------------------------------------------------
-%%% Internal functions
-%%--------------------------------------------------------------------
 check_starttls(SockMod, Socket, Receiver, Opts) ->
     TLSEnabled = lists:member(tls, Opts),
-    TLSOpts = lists:filter(fun({certfile, _}) -> true;
-			      (_) -> false
-			   end, Opts),
-    if
-	TLSEnabled ->
-	    {ok, TLSSocket} = tls:tcp_to_tls(Socket, TLSOpts),
-	    ejabberd_receiver:starttls(Receiver, TLSSocket),
-	    {tls, TLSSocket};
-	true ->
-	    {SockMod, Socket}
+    TLSOpts = lists:filter(fun ({certfile, _}) -> true;
+			       (_) -> false
+			   end,
+			   Opts),
+    if TLSEnabled ->
+	   {ok, TLSSocket} = ejabberd_receiver:starttls(Receiver,
+							TLSOpts),
+	   {tls, TLSSocket};
+       true -> {SockMod, Socket}
     end.
 
+peername(SockMod, Socket) ->
+    case SockMod of
+      gen_tcp -> inet:peername(Socket);
+      _ -> SockMod:peername(Socket)
+    end.

src/ejabberd_hooks.erl

@@ -5,7 +5,7 @@
 %%% Created :  8 Aug 2004 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -67,58 +67,76 @@
 start_link() ->
     gen_server:start_link({local, ejabberd_hooks}, ejabberd_hooks, [], []).
 
-%% @spec (Hook::atom(), Function::function(), Seq::integer()) -> ok
+-spec add(atom(), fun(), number()) -> any().
+
 %% @doc See add/4.
 add(Hook, Function, Seq) when is_function(Function) ->
     add(Hook, global, undefined, Function, Seq).
 
+-spec add(atom(), binary() | atom(), fun() | atom() , number()) -> any().
 add(Hook, Host, Function, Seq) when is_function(Function) ->
     add(Hook, Host, undefined, Function, Seq);
 
-%% @spec (Hook::atom(), Module::atom(), Function::atom(), Seq::integer()) -> ok
 %% @doc Add a module and function to this hook.
 %% The integer sequence is used to sort the calls: low number is called before high number.
 add(Hook, Module, Function, Seq) ->
     add(Hook, global, Module, Function, Seq).
 
+-spec add(atom(), binary() | global, atom(), atom() | fun(), number()) -> any().
+
 add(Hook, Host, Module, Function, Seq) ->
     gen_server:call(ejabberd_hooks, {add, Hook, Host, Module, Function, Seq}).
 
+-spec add_dist(atom(), atom(), atom(), atom() | fun(), number()) -> any().
+
 add_dist(Hook, Node, Module, Function, Seq) ->
     gen_server:call(ejabberd_hooks, {add, Hook, global, Node, Module, Function, Seq}).
 
+-spec add_dist(atom(), binary() | global, atom(), atom(), atom() | fun(), number()) -> any().
+
 add_dist(Hook, Host, Node, Module, Function, Seq) ->
     gen_server:call(ejabberd_hooks, {add, Hook, Host, Node, Module, Function, Seq}).
 
-%% @spec (Hook::atom(), Function::function(), Seq::integer()) -> ok
+-spec delete(atom(), fun(), number()) -> ok.
+
 %% @doc See del/4.
 delete(Hook, Function, Seq) when is_function(Function) ->
     delete(Hook, global, undefined, Function, Seq).
 
+-spec delete(atom(), binary() | atom(), atom() | fun(), number()) -> ok.
+
 delete(Hook, Host, Function, Seq) when is_function(Function) ->
     delete(Hook, Host, undefined, Function, Seq);
 
-%% @spec (Hook::atom(), Module::atom(), Function::atom(), Seq::integer()) -> ok
 %% @doc Delete a module and function from this hook.
 %% It is important to indicate exactly the same information than when the call was added.
 delete(Hook, Module, Function, Seq) ->
     delete(Hook, global, Module, Function, Seq).
 
+-spec delete(atom(), binary() | global, atom(), atom() | fun(), number()) -> ok.
+
 delete(Hook, Host, Module, Function, Seq) ->
     gen_server:call(ejabberd_hooks, {delete, Hook, Host, Module, Function, Seq}).
 
+-spec delete_dist(atom(), atom(), atom(), atom() | fun(), number()) -> ok.
+
 delete_dist(Hook, Node, Module, Function, Seq) ->
     delete_dist(Hook, global, Node, Module, Function, Seq).
 
+-spec delete_dist(atom(), binary() | global, atom(), atom(), atom() | fun(), number()) -> ok.
+
 delete_dist(Hook, Host, Node, Module, Function, Seq) ->
     gen_server:call(ejabberd_hooks, {delete, Hook, Host, Node, Module, Function, Seq}).
 
-%% @spec (Hook::atom(), Args) -> ok
+-spec run(atom(), list()) -> ok.
+
 %% @doc Run the calls of this hook in order, don't care about function results.
 %% If a call returns stop, no more calls are performed.
 run(Hook, Args) ->
     run(Hook, global, Args).
 
+-spec run(atom(), binary() | global, list()) -> ok.
+
 run(Hook, Host, Args) ->
     case ets:lookup(hooks, {Hook, Host}) of
 	[{_, Ls}] ->
@@ -127,7 +145,8 @@ run(Hook, Host, Args) ->
 	    ok
     end.
 
-%% @spec (Hook::atom(), Val, Args) -> Val | stopped | NewVal
+-spec run_fold(atom(), any(), list()) -> any().
+
 %% @doc Run the calls of this hook in order.
 %% The arguments passed to the function are: [Val | Args].
 %% The result of a call is used as Val for the next call.
@@ -136,6 +155,8 @@ run(Hook, Host, Args) ->
 run_fold(Hook, Val, Args) ->
     run_fold(Hook, global, Val, Args).
 
+-spec run_fold(atom(), binary() | global, any(), list()) -> any().
+
 run_fold(Hook, Host, Val, Args) ->
     case ets:lookup(hooks, {Hook, Host}) of
 	[{_, Ls}] ->

src/ejabberd_iq_sup.erl

@@ -0,0 +1,35 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2012, Evgeniy Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 25 May 2012 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(ejabberd_iq_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callbacks
+-export([init/1]).
+
+-define(SERVER, ?MODULE).
+
+%%%===================================================================
+%%% API functions
+%%%===================================================================
+start_link() ->
+    supervisor:start_link({local, ?SERVER}, ?MODULE, []).
+
+%%%===================================================================
+%%% Supervisor callbacks
+%%%===================================================================
+init([]) ->
+    {ok, {{one_for_one,10,1}, []}}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================

src/ejabberd_listener.erl

@@ -5,7 +5,7 @@
 %%% Created : 16 Nov 2002 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -35,7 +35,9 @@
 	 stop_listener/2,
 	 parse_listener_portip/2,
 	 add_listener/3,
-	 delete_listener/2
+	 delete_listener/2,
+	 rate_limit/2,
+         validate_cfg/1
 	]).
 
 -include("ejabberd.hrl").
@@ -53,7 +55,7 @@ init(_) ->
     {ok, {{one_for_one, 10, 1}, []}}.
 
 bind_tcp_ports() ->
-    case ejabberd_config:get_local_option(listen) of
+    case ejabberd_config:get_local_option(listen, fun validate_cfg/1) of
 	undefined ->
 	    ignore;
 	Ls ->
@@ -77,7 +79,8 @@ bind_tcp_port(PortIP, Module, RawOpts) ->
 		udp -> ok;
 		_ ->
 		    ListenSocket = listen_tcp(PortIP, Module, SockOpts, Port, IPS),
-		    ets:insert(listen_sockets, {PortIP, ListenSocket})
+		    ets:insert(listen_sockets, {PortIP, ListenSocket}),
+                    ok
 	    end
     catch
 	throw:{error, Error} ->
@@ -85,7 +88,7 @@ bind_tcp_port(PortIP, Module, RawOpts) ->
     end.
 
 start_listeners() ->
-    case ejabberd_config:get_local_option(listen) of
+    case ejabberd_config:get_local_option(listen, fun validate_cfg/1) of
 	undefined ->
 	    ignore;
 	Ls ->
@@ -173,7 +176,11 @@ listen_tcp(PortIP, Module, SockOpts, Port, IPS) ->
 			catch
 			    _:_ -> []
 			end,
-	    Res = gen_tcp:listen(Port, [binary,
+	    DeliverAs = case Module of
+			    ejabberd_xmlrpc -> list;
+			    _ -> binary
+			end,
+	    Res = gen_tcp:listen(Port, [DeliverAs,
 					{packet, 0},
 					{active, false},
 					{reuseaddr, true},
@@ -205,6 +212,13 @@ listen_tcp(PortIP, Module, SockOpts, Port, IPS) ->
 %% but they are only used when no IP address was specified in the PortIP.
 %% The IP version (either IPv4 or IPv6) is inferred from the IP address type,
 %% so the option inet/inet6 is only used when no IP is specified at all.
+-spec parse_listener_portip(port_ip_transport(), list()) -> {inet:port_number(),
+                                                             inet:ip_address(),
+                                                             binary(),
+                                                             inet | inet6,
+                                                             transport(),
+                                                             list()}.
+
 parse_listener_portip(PortIP, Opts) ->
     {IPOpt, Opts2} = strip_ip_option(Opts),
     {IPVOpt, OptsClean} = case lists:member(inet6, Opts2) of
@@ -215,17 +229,17 @@ parse_listener_portip(PortIP, Opts) ->
 	case add_proto(PortIP, Opts) of
 	    {P, Prot} ->
 		T = get_ip_tuple(IPOpt, IPVOpt),
-		S = inet_parse:ntoa(T),
+		S = jlib:ip_to_list(T),
 		{P, T, S, Prot};
 	    {P, T, Prot} when is_integer(P) and is_tuple(T) ->
-		S = inet_parse:ntoa(T),
+		S = jlib:ip_to_list(T),
 		{P, T, S, Prot};
-	    {P, S, Prot} when is_integer(P) and is_list(S) ->
-		[S | _] = string:tokens(S, "/"),
-		{ok, T} = inet_parse:address(S),
+	    {P, S, Prot} when is_integer(P) and is_binary(S) ->
+		[S | _] = str:tokens(S, <<"/">>),
+		{ok, T} = inet_parse:address(binary_to_list(S)),
 		{P, T, S, Prot}
 	end,
-    IPV = case size(IPT) of
+    IPV = case tuple_size(IPT) of
 	      4 -> inet;
 	      8 -> inet6
 	  end,
@@ -274,6 +288,9 @@ get_ip_tuple(IPOpt, _IPVOpt) ->
     IPOpt.
 
 accept(ListenSocket, Module, Opts) ->
+    accept(ListenSocket, Module, Opts, 0).
+accept(ListenSocket, Module, Opts, Interval) ->
+    NewInterval = check_rate_limit(Interval),
     case gen_tcp:accept(ListenSocket) of
 	{ok, Socket} ->
 	    case {inet:sockname(Socket), inet:peername(Socket)} of
@@ -288,11 +305,11 @@ accept(ListenSocket, Module, Opts) ->
 			  false -> ejabberd_socket
 		      end,
 	    CallMod:start(strip_frontend(Module), gen_tcp, Socket, Opts),
-	    accept(ListenSocket, Module, Opts);
+	    accept(ListenSocket, Module, Opts, NewInterval);
 	{error, Reason} ->
 	    ?ERROR_MSG("(~w) Failed TCP accept: ~w",
                        [ListenSocket, Reason]),
-	    accept(ListenSocket, Module, Opts)
+	    accept(ListenSocket, Module, Opts, NewInterval)
     end.
 
 udp_recv(Socket, Module, Opts) ->
@@ -337,7 +354,7 @@ start_listener2(Port, Module, Opts) ->
     start_listener_sup(Port, Module, Opts).
 
 start_module_sup(_Port, Module) ->
-    Proc1 = gen_mod:get_module_proc("sup", Module),
+    Proc1 = gen_mod:get_module_proc(<<"sup">>, Module),
     ChildSpec1 =
 	{Proc1,
 	 {ejabberd_tmp_sup, start_link, [Proc1, strip_frontend(Module)]},
@@ -357,7 +374,7 @@ start_listener_sup(Port, Module, Opts) ->
     supervisor:start_child(ejabberd_listeners, ChildSpec).
 
 stop_listeners() ->
-    Ports = ejabberd_config:get_local_option(listen),
+    Ports = ejabberd_config:get_local_option(listen, fun validate_cfg/1),
     lists:foreach(
       fun({PortIpNetp, Module, _Opts}) ->
 	      delete_listener(PortIpNetp, Module)
@@ -371,6 +388,8 @@ stop_listeners() ->
 %%      IPT = tuple()
 %%      IPS = string()
 %%      Module = atom()
+-spec stop_listener(port_ip_transport(), module()) -> ok | {error, any()}.
+
 stop_listener(PortIP, _Module) ->
     supervisor:terminate_child(ejabberd_listeners, PortIP),
     supervisor:delete_child(ejabberd_listeners, PortIP).
@@ -390,7 +409,8 @@ add_listener(PortIP, Module, Opts) ->
     PortIP1 = {Port, IPT, Proto},
     case start_listener(PortIP1, Module, Opts) of
 	{ok, _Pid} ->
-	    Ports = case ejabberd_config:get_local_option(listen) of
+	    Ports = case ejabberd_config:get_local_option(
+                           listen, fun validate_cfg/1) of
 			undefined ->
 			    [];
 			Ls ->
@@ -420,7 +440,8 @@ delete_listener(PortIP, Module) ->
 delete_listener(PortIP, Module, Opts) ->
     {Port, IPT, _, _, Proto, _} = parse_listener_portip(PortIP, Opts),
     PortIP1 = {Port, IPT, Proto},
-    Ports = case ejabberd_config:get_local_option(listen) of
+    Ports = case ejabberd_config:get_local_option(
+                   listen, fun validate_cfg/1) of
 		undefined ->
 		    [];
 		Ls ->
@@ -430,11 +451,14 @@ delete_listener(PortIP, Module, Opts) ->
     ejabberd_config:add_local_option(listen, Ports1),
     stop_listener(PortIP1, Module).
 
+
+-spec is_frontend({frontend, module} | module()) -> boolean().
+
 is_frontend({frontend, _Module}) -> true;
 is_frontend(_) -> false.
 
-%% @doc(FrontMod) -> atom()
-%% where FrontMod = atom() | {frontend, atom()}
+-spec strip_frontend({frontend, module()} | module()) -> module().
+
 strip_frontend({frontend, Module}) -> Module;
 strip_frontend(Module) when is_atom(Module) -> Module.
 
@@ -505,7 +529,7 @@ socket_error(Reason, PortIP, Module, SockOpts, Port, IPS) ->
 		      "IP address not available: " ++ IPS;
 		  eaddrinuse ->
 		      "IP address and port number already used: "
-			  ++IPS++" "++integer_to_list(Port);
+			  ++binary_to_list(IPS)++" "++integer_to_list(Port);
 		  _ ->
 		      format_error(Reason)
 	      end,
@@ -520,3 +544,81 @@ format_error(Reason) ->
 	ReasonStr ->
 	    ReasonStr
     end.
+
+%% Set interval between two accepts on given port
+rate_limit([], _Interval) ->
+    ok;
+rate_limit([Port|Ports], Interval) ->
+    rate_limit(Port, Interval),
+    rate_limit(Ports, Interval);
+rate_limit(Port, Interval) ->
+    case get_listener_pid_by_port(Port) of
+	undefined -> no_listener;
+	Pid -> Pid ! {rate_limit, Interval}, ok
+    end.
+
+get_listener_pid_by_port(Port) ->
+    ListenerPids = [Pid || {{P,_,_},Pid,_,_} <-
+			       supervisor:which_children(erlang:whereis(ejabberd_listeners)),
+			   P == Port],
+    ListenerPid = case ListenerPids of
+		      [] -> undefined;
+		      [LPid|_] -> LPid
+		  end,
+    ListenerPid.
+
+check_rate_limit(Interval) ->
+    NewInterval = receive
+		      {rate_limit, AcceptInterval} ->
+			  AcceptInterval
+		  after 0 ->
+			  Interval
+		  end,
+    case NewInterval of
+	0  -> ok;
+	Ms ->
+	    timer:sleep(Ms)
+    end,
+    NewInterval.
+
+-define(IS_CHAR(C), (is_integer(C) and (C >= 0) and (C =< 255))).
+-define(IS_UINT(U), (is_integer(U) and (U >= 0) and (U =< 65535))).
+-define(IS_PORT(P), (is_integer(P) and (P > 0) and (P =< 65535))).
+-define(IS_TRANSPORT(T), ((T == tcp) or (T == udp))).
+
+-type transport() :: udp | tcp.
+-type port_ip_transport() :: inet:port_number() |
+                             {inet:port_number(), transport()} |
+                             {inet:port_number(), inet:ip_address()} |
+                             {inet:port_number(), inet:ip_address(),
+                              transport()}.
+
+-spec validate_cfg(list()) -> [{port_ip_transport(), module(), list()}].
+
+validate_cfg(L) ->
+    lists:map(
+      fun({PortIPTransport, Mod, Opts}) when is_atom(Mod), is_list(Opts) ->
+              case PortIPTransport of
+                  Port when ?IS_PORT(Port) ->
+                      {Port, Mod, Opts};
+                  {Port, Trans} when ?IS_PORT(Port) and ?IS_TRANSPORT(Trans) ->
+                      {{Port, Trans}, Mod, Opts};
+                  {Port, IP} when ?IS_PORT(Port) ->
+                      {{Port, prepare_ip(IP)}, Mod, Opts};
+                  {Port, IP, Trans} when ?IS_PORT(Port) and ?IS_TRANSPORT(Trans) ->
+                      {{Port, prepare_ip(IP), Trans}, Mod, Opts}
+              end
+      end, L).
+
+prepare_ip({A, B, C, D} = IP)
+  when ?IS_CHAR(A) and ?IS_CHAR(B) and ?IS_CHAR(C) and ?IS_CHAR(D) ->
+    IP;
+prepare_ip({A, B, C, D, E, F, G, H} = IP)
+  when ?IS_UINT(A) and ?IS_UINT(B) and ?IS_UINT(C) and ?IS_UINT(D)
+       and ?IS_UINT(E) and ?IS_UINT(F) and ?IS_UINT(G) and ?IS_UINT(H) ->
+    IP;
+prepare_ip(IP) when is_list(IP) ->
+    {ok, Addr} = inet_parse:address(IP),
+    Addr;
+prepare_ip(IP) when is_binary(IP) ->
+    prepare_ip(binary_to_list(IP)).

src/ejabberd_local.erl

@@ -5,7 +5,7 @@
 %%% Created : 30 Nov 2002 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,6 +25,7 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_local).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
@@ -32,45 +33,35 @@
 %% API
 -export([start_link/0]).
 
--export([route/3,
-	 route_iq/4,
-	 route_iq/5,
-	 process_iq_reply/3,
-	 register_iq_handler/4,
-	 register_iq_handler/5,
-	 register_iq_response_handler/4,
-	 register_iq_response_handler/5,
-	 unregister_iq_handler/2,
-	 unregister_iq_response_handler/2,
-	 refresh_iq_handlers/0,
-	 bounce_resource_packet/3
-	]).
+-export([route/3, route_iq/4, route_iq/5,
+	 process_iq_reply/3, register_iq_handler/4,
+	 register_iq_handler/5, register_iq_response_handler/4,
+	 register_iq_response_handler/5, unregister_iq_handler/2,
+	 unregister_iq_response_handler/2, refresh_iq_handlers/0,
+	 bounce_resource_packet/3]).
 
 %% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
-	 terminate/2, code_change/3]).
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, terminate/2, code_change/3]).
 
 -include("ejabberd.hrl").
+
 -include("jlib.hrl").
 
 -record(state, {}).
 
--record(iq_response, {id, module, function, timer}).
+-record(iq_response, {id = <<"">> :: binary(),
+                      module :: atom(),
+                      function :: atom() | fun(),
+                      timer = make_ref() :: reference()}).
 
 -define(IQTABLE, local_iqtable).
 
-%% This value is used in SIP and Megaco for a transaction lifetime.
 -define(IQ_TIMEOUT, 32000).
 
-%%====================================================================
-%% API
-%%====================================================================
-%%--------------------------------------------------------------------
-%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
-%% Description: Starts the server
-%%--------------------------------------------------------------------
 start_link() ->
-    gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+    gen_server:start_link({local, ?MODULE}, ?MODULE, [],
+			  []).
 
 process_iq(From, To, Packet) ->
     IQ = jlib:iq_query_info(Packet),
@@ -87,7 +78,13 @@ process_iq(From, To, Packet) ->
 			true ->
 			    ok
 		    end;
-		[{_, Module, Function, Opts}] ->
+                [{_, Module, Function, Opts1}|Tail] ->
+                    Opts = if is_pid(Opts1) ->
+                                   [Opts1 |
+                                    [Pid || {_, _, _, Pid} <- Tail]];
+                              true ->
+                                   Opts1
+                           end,
 		    gen_iq_handler:handle(Host, Module, Function, Opts,
 					  From, To, IQ);
 		[] ->
@@ -106,64 +103,61 @@ process_iq(From, To, Packet) ->
 
 process_iq_reply(From, To, #iq{id = ID} = IQ) ->
     case get_iq_callback(ID) of
-	{ok, undefined, Function} ->
-	    Function(IQ),
-	    ok;
-	{ok, Module, Function} ->
-	    Module:Function(From, To, IQ),
-	    ok;
-	_ ->
-	    nothing
+      {ok, undefined, Function} -> Function(IQ), ok;
+      {ok, Module, Function} ->
+	  Module:Function(From, To, IQ), ok;
+      _ -> nothing
     end.
 
 route(From, To, Packet) ->
     case catch do_route(From, To, Packet) of
-	{'EXIT', Reason} ->
-	    ?ERROR_MSG("~p~nwhen processing: ~p",
-		       [Reason, {From, To, Packet}]);
-	_ ->
-	    ok
+      {'EXIT', Reason} ->
+	  ?ERROR_MSG("~p~nwhen processing: ~p",
+		     [Reason, {From, To, Packet}]);
+      _ -> ok
     end.
 
 route_iq(From, To, IQ, F) ->
     route_iq(From, To, IQ, F, undefined).
 
-route_iq(From, To, #iq{type = Type} = IQ, F, Timeout) when is_function(F) ->
+route_iq(From, To, #iq{type = Type} = IQ, F, Timeout)
+    when is_function(F) ->
     Packet = if Type == set; Type == get ->
-		     ID = randoms:get_string(),
-		     Host = From#jid.lserver,
-		     register_iq_response_handler(Host, ID, undefined, F, Timeout),
-		     jlib:iq_to_xml(IQ#iq{id = ID});
-		true ->
-		     jlib:iq_to_xml(IQ)
+		    ID = ejabberd_router:make_id(),
+		    Host = From#jid.lserver,
+		    register_iq_response_handler(Host, ID, undefined, F,
+						 Timeout),
+		    jlib:iq_to_xml(IQ#iq{id = ID});
+		true -> jlib:iq_to_xml(IQ)
 	     end,
     ejabberd_router:route(From, To, Packet).
 
-register_iq_response_handler(Host, ID, Module, Function) ->
-    register_iq_response_handler(Host, ID, Module, Function, undefined).
+register_iq_response_handler(Host, ID, Module,
+			     Function) ->
+    register_iq_response_handler(Host, ID, Module, Function,
+				 undefined).
 
-register_iq_response_handler(_Host, ID, Module, Function, Timeout0) ->
+register_iq_response_handler(_Host, ID, Module,
+			     Function, Timeout0) ->
     Timeout = case Timeout0 of
-		  undefined ->
-		      ?IQ_TIMEOUT;
-		  N when is_integer(N), N > 0 ->
-		      N
+		undefined -> ?IQ_TIMEOUT;
+		N when is_integer(N), N > 0 -> N
 	      end,
     TRef = erlang:start_timer(Timeout, ejabberd_local, ID),
-    mnesia:dirty_write(#iq_response{id = ID,
-				    module = Module,
-				    function = Function,
-				    timer = TRef}).
+    ets:insert(iq_response,
+	       #iq_response{id = ID, module = Module,
+			    function = Function, timer = TRef}).
 
 register_iq_handler(Host, XMLNS, Module, Fun) ->
-    ejabberd_local ! {register_iq_handler, Host, XMLNS, Module, Fun}.
+    ejabberd_local !
+      {register_iq_handler, Host, XMLNS, Module, Fun}.
 
 register_iq_handler(Host, XMLNS, Module, Fun, Opts) ->
-    ejabberd_local ! {register_iq_handler, Host, XMLNS, Module, Fun, Opts}.
+    ejabberd_local !
+      {register_iq_handler, Host, XMLNS, Module, Fun, Opts}.
 
 unregister_iq_response_handler(_Host, ID) ->
-    catch get_iq_callback(ID),
-    ok.
+    catch get_iq_callback(ID), ok.
 
 unregister_iq_handler(Host, XMLNS) ->
     ejabberd_local ! {unregister_iq_handler, Host, XMLNS}.
@@ -172,7 +166,8 @@ refresh_iq_handlers() ->
     ejabberd_local ! refresh_iq_handlers.
 
 bounce_resource_packet(From, To, Packet) ->
-    Err = jlib:make_error_reply(Packet, ?ERR_ITEM_NOT_FOUND),
+    Err = jlib:make_error_reply(Packet,
+				?ERR_ITEM_NOT_FOUND),
     ejabberd_router:route(To, From, Err),
     stop.
 
@@ -180,13 +175,6 @@ bounce_resource_packet(From, To, Packet) ->
 %% gen_server callbacks
 %%====================================================================
 
-%%--------------------------------------------------------------------
-%% Function: init(Args) -> {ok, State} |
-%%                         {ok, State, Timeout} |
-%%                         ignore               |
-%%                         {stop, Reason}
-%% Description: Initiates the server
-%%--------------------------------------------------------------------
 init([]) ->
     lists:foreach(
       fun(Host) ->
@@ -194,62 +182,45 @@ init([]) ->
 	      ejabberd_hooks:add(local_send_to_resource_hook, Host,
 				 ?MODULE, bounce_resource_packet, 100)
       end, ?MYHOSTS),
-    catch ets:new(?IQTABLE, [named_table, public]),
-    update_table(),
-    mnesia:create_table(iq_response,
-			[{ram_copies, [node()]},
-			 {attributes, record_info(fields, iq_response)}]),
-    mnesia:add_table_copy(iq_response, node(), ram_copies),
+    catch ets:new(?IQTABLE, [named_table, public, bag]),
+    mnesia:delete_table(iq_response),
+    catch ets:new(iq_response,
+		  [named_table, public, {keypos, #iq_response.id}]),
     {ok, #state{}}.
 
-%%--------------------------------------------------------------------
-%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
-%%                                      {reply, Reply, State, Timeout} |
-%%                                      {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, Reply, State} |
-%%                                      {stop, Reason, State}
-%% Description: Handling call messages
-%%--------------------------------------------------------------------
 handle_call(_Request, _From, State) ->
-    Reply = ok,
-    {reply, Reply, State}.
+    Reply = ok, {reply, Reply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, State}
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
-handle_cast(_Msg, State) ->
-    {noreply, State}.
+handle_cast(_Msg, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%%                                       {noreply, State, Timeout} |
-%%                                       {stop, Reason, State}
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
 handle_info({route, From, To, Packet}, State) ->
     case catch do_route(From, To, Packet) of
-	{'EXIT', Reason} ->
-	    ?ERROR_MSG("~p~nwhen processing: ~p",
-		       [Reason, {From, To, Packet}]);
-	_ ->
-	    ok
+      {'EXIT', Reason} ->
+	  ?ERROR_MSG("~p~nwhen processing: ~p",
+		     [Reason, {From, To, Packet}]);
+      _ -> ok
     end,
     {noreply, State};
-handle_info({register_iq_handler, Host, XMLNS, Module, Function}, State) ->
+handle_info({register_iq_handler, Host, XMLNS, Module,
+	     Function},
+	    State) ->
     ets:insert(?IQTABLE, {{XMLNS, Host}, Module, Function}),
     catch mod_disco:register_feature(Host, XMLNS),
     {noreply, State};
 handle_info({register_iq_handler, Host, XMLNS, Module, Function, Opts}, State) ->
     ets:insert(?IQTABLE, {{XMLNS, Host}, Module, Function, Opts}),
+    if is_pid(Opts) ->
+            erlang:monitor(process, Opts);
+       true ->
+            ok
+    end,
     catch mod_disco:register_feature(Host, XMLNS),
     {noreply, State};
-handle_info({unregister_iq_handler, Host, XMLNS}, State) ->
+handle_info({unregister_iq_handler, Host, XMLNS},
+	    State) ->
     case ets:lookup(?IQTABLE, {XMLNS, Host}) of
-	[{_, Module, Function, Opts}] ->
+        [{_, Module, Function, Opts1}|Tail] when is_pid(Opts1) ->
+            Opts = [Opts1 | [Pid || {_, _, _, Pid} <- Tail]],
 	    gen_iq_handler:stop_iq_handler(Module, Function, Opts);
 	_ ->
 	    ok
@@ -258,20 +229,26 @@ handle_info({unregister_iq_handler, Host, XMLNS}, State) ->
     catch mod_disco:unregister_feature(Host, XMLNS),
     {noreply, State};
 handle_info(refresh_iq_handlers, State) ->
-    lists:foreach(
-      fun(T) ->
-	      case T of
-		  {{XMLNS, Host}, _Module, _Function, _Opts} ->
-		      catch mod_disco:register_feature(Host, XMLNS);
-		  {{XMLNS, Host}, _Module, _Function} ->
-		      catch mod_disco:register_feature(Host, XMLNS);
-		  _ ->
-		      ok
-	      end
-      end, ets:tab2list(?IQTABLE)),
+    lists:foreach(fun (T) ->
+			  case T of
+			    {{XMLNS, Host}, _Module, _Function, _Opts} ->
+				catch mod_disco:register_feature(Host, XMLNS);
+			    {{XMLNS, Host}, _Module, _Function} ->
+				catch mod_disco:register_feature(Host, XMLNS);
+			    _ -> ok
+			  end
+		  end,
+		  ets:tab2list(?IQTABLE)),
     {noreply, State};
 handle_info({timeout, _TRef, ID}, State) ->
-    process_iq_timeout(ID),
+    spawn(fun () -> process_iq_timeout(ID) end),
+    {noreply, State};
+handle_info({'DOWN', _MRef, _Type, Pid, _Info}, State) ->
+    Rs = ets:select(?IQTABLE,
+                    [{{'_','_','_','$1'},
+                      [{'==', '$1', Pid}],
+                      ['$_']}]),
+    lists:foreach(fun(R) -> ets:delete_object(?IQTABLE, R) end, Rs),
     {noreply, State};
 handle_info(_Info, State) ->
     {noreply, State}.
@@ -297,81 +274,49 @@ code_change(_OldVsn, State, _Extra) ->
 %%% Internal functions
 %%--------------------------------------------------------------------
 do_route(From, To, Packet) ->
-    ?DEBUG("local route~n\tfrom ~p~n\tto ~p~n\tpacket ~P~n",
+    ?DEBUG("local route~n\tfrom ~p~n\tto ~p~n\tpacket "
+	   "~P~n",
 	   [From, To, Packet, 8]),
-    if
-	To#jid.luser /= "" ->
-	    ejabberd_sm:route(From, To, Packet);
-	To#jid.lresource == "" ->
-	    {xmlelement, Name, _Attrs, _Els} = Packet,
-	    case Name of
-		"iq" ->
-		    process_iq(From, To, Packet);
-		"message" ->
-		    ok;
-		"presence" ->
-		    ok;
-		_ ->
-		    ok
-	    end;
-	true ->
-	    {xmlelement, _Name, Attrs, _Els} = Packet,
-	    case xml:get_attr_s("type", Attrs) of
-		"error" -> ok;
-		"result" -> ok;
-		_ ->
-		    ejabberd_hooks:run(local_send_to_resource_hook,
-				       To#jid.lserver,
-				       [From, To, Packet])
-	    end
-	end.
-
-update_table() ->
-    case catch mnesia:table_info(iq_response, attributes) of
-	[id, module, function] ->
-	    mnesia:delete_table(iq_response);
-	[id, module, function, timer] ->
-	    ok;
-	{'EXIT', _} ->
-	    ok
+    if To#jid.luser /= <<"">> ->
+	   ejabberd_sm:route(From, To, Packet);
+       To#jid.lresource == <<"">> ->
+	   #xmlel{name = Name} = Packet,
+	   case Name of
+	     <<"iq">> -> process_iq(From, To, Packet);
+	     <<"message">> -> ok;
+	     <<"presence">> -> ok;
+	     _ -> ok
+	   end;
+       true ->
+	   #xmlel{attrs = Attrs} = Packet,
+	   case xml:get_attr_s(<<"type">>, Attrs) of
+	     <<"error">> -> ok;
+	     <<"result">> -> ok;
+	     _ ->
+		 ejabberd_hooks:run(local_send_to_resource_hook,
+				    To#jid.lserver, [From, To, Packet])
+	   end
     end.
 
 get_iq_callback(ID) ->
-    case mnesia:dirty_read(iq_response, ID) of
-	[#iq_response{module = Module, timer = TRef,
-		      function = Function}] ->
-	    cancel_timer(TRef),
-	    mnesia:dirty_delete(iq_response, ID),
-	    {ok, Module, Function};
-	_ ->
-	    error
+    case ets:lookup(iq_response, ID) of
+      [#iq_response{module = Module, timer = TRef,
+		    function = Function}] ->
+	  cancel_timer(TRef),
+	  ets:delete(iq_response, ID),
+	  {ok, Module, Function};
+      _ -> error
     end.
 
 process_iq_timeout(ID) ->
-    spawn(fun process_iq_timeout/0) ! ID.
-
-process_iq_timeout() ->
-    receive
-	ID ->
-	    case get_iq_callback(ID) of
-		{ok, undefined, Function} ->
-		    Function(timeout);
-		_ ->
-		    ok
-	    end
-    after 5000 ->
-	    ok
+    case get_iq_callback(ID) of
+      {ok, undefined, Function} -> Function(timeout);
+      _ -> ok
     end.
 
 cancel_timer(TRef) ->
     case erlang:cancel_timer(TRef) of
-	false ->
-	    receive
-                {timeout, TRef, _} ->
-                    ok
-            after 0 ->
-                    ok
-            end;
-        _ ->
-            ok
+      false ->
+	  receive {timeout, TRef, _} -> ok after 0 -> ok end;
+      _ -> ok
     end.

src/ejabberd_logger.erl

@@ -0,0 +1,35 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2012, Evgeniy Khramtsov
+%%% @doc This module is needed to shut up Dialyzer
+%%% @end
+%%% Created : 10 Jul 2012 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(ejabberd_logger).
+
+-compile({no_auto_import, [{get, 0}]}).
+
+%% API
+-export([debug_msg/4, info_msg/4, warning_msg/4,
+         error_msg/4, critical_msg/4, get/0]).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+-spec debug_msg(atom(), pos_integer(), string(), list()) -> ok.
+-spec info_msg(atom(), pos_integer(), string(), list()) -> ok.
+-spec warning_msg(atom(), pos_integer(), string(), list()) -> ok.
+-spec error_msg(atom(), pos_integer(), string(), list()) -> ok.
+-spec critical_msg(atom(), pos_integer(), string(), list()) -> ok.
+-spec get() -> {non_neg_integer(), [{atom(), non_neg_integer()}]}.
+
+debug_msg(_Mod, _Line, _Format, _Args) -> ok.
+info_msg(_Mod, _Line, _Format, _Args) -> ok.
+warning_msg(_Mod, _Line, _Format, _Args) -> ok.
+error_msg(_Mod, _Line, _Format, _Args) -> ok.
+critical_msg(_Mod, _Line, _Format, _Args) -> ok.
+get() -> {0, [{foo, 0}]}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================

src/ejabberd_logger_h.erl

@@ -5,7 +5,7 @@
 %%% Created : 23 Oct 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as

src/ejabberd_loglevel.erl

@@ -9,7 +9,7 @@
 %%% Created : 29 Nov 2006 by Mickael Remond <mremond@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as

src/ejabberd_node_groups.erl

@@ -5,7 +5,7 @@
 %%% Created :  1 Nov 2006 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -31,6 +31,7 @@
 
 %% API
 -export([start_link/0,
+	 start/0,
 	 join/1,
 	 leave/1,
 	 get_members/1,
@@ -40,13 +41,8 @@
 -export([init/1, handle_call/3, handle_cast/2, handle_info/2,
 	 terminate/2, code_change/3]).
 
--ifdef(SSL40).
--define(PG2, pg2).
--else.
--define(PG2, pg2_backport).
--endif.
 
--record(state, {}).
+-record(state, {groups = [] :: [frontend | backend]}).
 
 %%====================================================================
 %% API
@@ -55,25 +51,34 @@
 %% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
 %% Description: Starts the server
 %%--------------------------------------------------------------------
+start() ->
+    ChildSpec = {?MODULE,
+		 {?MODULE, start_link, []},
+		 permanent,
+		 brutal_kill,
+		 worker,
+		 [?MODULE]},
+    supervisor:start_child(ejabberd_sup, ChildSpec).
+
 start_link() ->
     gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
 
 join(Name) ->
     PG = {?MODULE, Name},
-    ?PG2:create(PG),
-    ?PG2:join(PG, whereis(?MODULE)).
+    pg2:create(PG),
+    pg2:join(PG, whereis(?MODULE)).
 
 leave(Name) ->
     PG = {?MODULE, Name},
-    ?PG2:leave(PG, whereis(?MODULE)).
+    pg2:leave(PG, whereis(?MODULE)).
 
 get_members(Name) ->
     PG = {?MODULE, Name},
-    [node(P) || P <- ?PG2:get_members(PG)].
+    [node(P) || P <- pg2:get_members(PG)].
 
 get_closest_node(Name) ->
     PG = {?MODULE, Name},
-    node(?PG2:get_closest_pid(PG)).
+    node(pg2:get_closest_pid(PG)).
 
 %%====================================================================
 %% gen_server callbacks
@@ -87,30 +92,22 @@ get_closest_node(Name) ->
 %% Description: Initiates the server
 %%--------------------------------------------------------------------
 init([]) ->
-    {FE, BE} =
-	case ejabberd_config:get_local_option(node_type) of
+    Groups =
+	case ejabberd_config:get_local_option(
+               node_type,
+               fun(frontend) -> frontend;
+                  (backend) -> backend;
+                  (generic) -> generic
+               end, generic) of
 	    frontend ->
-		{true, false};
+		[frontend];
 	    backend ->
-		{false, true};
+		[backend];
 	    generic ->
-		{true, true};
-	    undefined ->
-		{true, true}
+		[frontend, backend]
 	end,
-    if
-	FE ->
-	    join(frontend);
-	true ->
-	    ok
-    end,
-    if
-	BE ->
-	    join(backend);
-	true ->
-	    ok
-    end,
-    {ok, #state{}}.
+    lists:foreach(fun join/1, Groups),
+    {ok, #state{groups = Groups}}.
 
 %%--------------------------------------------------------------------
 %% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
@@ -150,7 +147,8 @@ handle_info(_Info, State) ->
 %% cleaning up. When it returns, the gen_server terminates with Reason.
 %% The return value is ignored.
 %%--------------------------------------------------------------------
-terminate(_Reason, _State) ->
+terminate(_Reason, #state{groups = Groups}) ->
+    lists:foreach(fun leave/1, Groups),
     ok.
 
 %%--------------------------------------------------------------------

src/ejabberd_rdbms.erl

@@ -5,7 +5,7 @@
 %%% Created : 31 Jan 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,54 +25,48 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_rdbms).
+
 -author('alexey@process-one.net').
 
 -export([start/0]).
+
 -include("ejabberd.hrl").
 
 start() ->
-    %% Check if ejabberd has been compiled with ODBC
     case catch ejabberd_odbc_sup:module_info() of
-	{'EXIT',{undef,_}} ->
-	    ?INFO_MSG("ejabberd has not been compiled with relational database support. Skipping database startup.", []);
-	_ ->
-	    %% If compiled with ODBC, start ODBC on the needed host
-	    start_hosts()
+      {'EXIT', {undef, _}} ->
+	  ?INFO_MSG("ejabberd has not been compiled with "
+		    "relational database support. Skipping "
+		    "database startup.",
+		    []);
+      _ -> start_hosts()
     end.
 
-%% Start relationnal DB module on the nodes where it is needed
 start_hosts() ->
-    lists:foreach(
-      fun(Host) ->
-	      case needs_odbc(Host) of
-		  true  -> start_odbc(Host);
-		  false -> ok
-	      end
-      end, ?MYHOSTS).
+    lists:foreach(fun (Host) ->
+			  case needs_odbc(Host) of
+			    true -> start_odbc(Host);
+			    false -> ok
+			  end
+		  end,
+		  ?MYHOSTS).
 
-%% Start the ODBC module on the given host
 start_odbc(Host) ->
-    Supervisor_name = gen_mod:get_module_proc(Host, ejabberd_odbc_sup),
-    ChildSpec =
-	{Supervisor_name,
-	 {ejabberd_odbc_sup, start_link, [Host]},
-	 transient,
-	 infinity,
-	 supervisor,
-	 [ejabberd_odbc_sup]},
+    Supervisor_name = gen_mod:get_module_proc(Host,
+					      ejabberd_odbc_sup),
+    ChildSpec = {Supervisor_name,
+		 {ejabberd_odbc_sup, start_link, [Host]}, transient,
+		 infinity, supervisor, [ejabberd_odbc_sup]},
     case supervisor:start_child(ejabberd_sup, ChildSpec) of
-	{ok, _PID} ->
-	    ok;
-	_Error ->
-	    ?ERROR_MSG("Start of supervisor ~p failed:~n~p~nRetrying...~n", [Supervisor_name, _Error]),
-	    start_odbc(Host)
+      {ok, _PID} -> ok;
+      _Error ->
+	  ?ERROR_MSG("Start of supervisor ~p failed:~n~p~nRetrying."
+		     "..~n",
+		     [Supervisor_name, _Error]),
+	  start_odbc(Host)
     end.
 
-%% Returns true if we have configured odbc_server for the given host
 needs_odbc(Host) ->
     LHost = jlib:nameprep(Host),
-    case ejabberd_config:get_local_option({odbc_server, LHost}) of
-	undefined ->
-	    false;
-	_ -> true
-    end.
+    ejabberd_config:get_local_option(
+      {odbc_server, LHost}, fun(_) -> true end, false).

src/ejabberd_receiver.erl

@@ -5,7 +5,7 @@
 %%% Created : 10 Nov 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,252 +25,275 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_receiver).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
 
 %% API
--export([start_link/4,
-	 start/3,
-	 start/4,
-	 change_shaper/2,
-	 reset_stream/1,
-	 starttls/2,
-	 compress/2,
-	 become_controller/2,
-	 close/1]).
+-export([start_link/4, start/3, start/4,
+	 change_shaper/2, reset_stream/1, starttls/2, starttls/3,
+	 compress/2, send/2, become_controller/2,
+	 change_controller/2, setopts/2, close/1]).
 
 %% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
-	 terminate/2, code_change/3]).
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, terminate/2, code_change/3]).
 
 -include("ejabberd.hrl").
 
--record(state, {socket,
-		sock_mod,
-		shaper_state,
-		c2s_pid,
-		max_stanza_size,
-		xml_stream_state,
-		timeout}).
+-record(state,
+	{socket :: inet:socket() | tls:tls_socket() | ejabberd_zlib:zlib_socket(),
+         sock_mod = gen_tcp :: gen_tcp | tls | ejabberd_zlib,
+         shaper_state = none :: shaper:shaper(),
+         c2s_pid :: pid(),
+	 max_stanza_size = infinity :: non_neg_integer() | infinity,
+         xml_stream_state :: xml_stream:xml_stream_state(),
+         tref :: reference(),
+         timeout = infinity:: timeout()}).
 
 -define(HIBERNATE_TIMEOUT, 90000).
 
-%%====================================================================
-%% API
-%%====================================================================
-%%--------------------------------------------------------------------
-%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
-%% Description: Starts the server
-%%--------------------------------------------------------------------
-start_link(Socket, SockMod, Shaper, MaxStanzaSize) ->
-    gen_server:start_link(
-      ?MODULE, [Socket, SockMod, Shaper, MaxStanzaSize], []).
+-spec start_link(inet:socket(), atom(), shaper:shaper(),
+                 non_neg_integer() | infinity) -> ignore |
+                                                  {error, any()} |
+                                                  {ok, pid()}.
+
+start_link(Socket, SockMod, Shaper, MaxStanzaSize) ->
+    gen_server:start_link(?MODULE,
+			  [Socket, SockMod, Shaper, MaxStanzaSize], []).
+
+-spec start(inet:socket(), atom(), shaper:shaper()) -> undefined | pid().
 
-%%--------------------------------------------------------------------
-%% Function: start() -> {ok,Pid} | ignore | {error,Error}
-%% Description: Starts the server
-%%--------------------------------------------------------------------
 start(Socket, SockMod, Shaper) ->
     start(Socket, SockMod, Shaper, infinity).
 
+-spec start(inet:socket(), atom(), shaper:shaper(),
+            non_neg_integer() | infinity) -> undefined | pid().
+
 start(Socket, SockMod, Shaper, MaxStanzaSize) ->
-    {ok, Pid} = supervisor:start_child(
-		  ejabberd_receiver_sup,
-		  [Socket, SockMod, Shaper, MaxStanzaSize]),
+    {ok, Pid} =
+	supervisor:start_child(ejabberd_receiver_sup,
+			       [Socket, SockMod, Shaper, MaxStanzaSize]),
     Pid.
 
+-spec change_shaper(pid(), shaper:shaper()) -> ok.
+
 change_shaper(Pid, Shaper) ->
     gen_server:cast(Pid, {change_shaper, Shaper}).
 
-reset_stream(Pid) ->
-    do_call(Pid, reset_stream).
+-spec reset_stream(pid()) -> ok | {error, any()}.
 
-starttls(Pid, TLSSocket) ->
-    do_call(Pid, {starttls, TLSSocket}).
+reset_stream(Pid) -> do_call(Pid, reset_stream).
 
-compress(Pid, ZlibSocket) ->
-    do_call(Pid, {compress, ZlibSocket}).
+-spec starttls(pid(), iodata()) -> {ok, tls:tls_socket()} | {error, any()}.
+
+starttls(Pid, TLSOpts) ->
+    starttls(Pid, TLSOpts, undefined).
+
+-spec starttls(pid(), list(), iodata() | undefined) -> {error, any()} |
+                                                       {ok, tls:tls_socket()}.
+
+starttls(Pid, TLSOpts, Data) ->
+    do_call(Pid, {starttls, TLSOpts, Data}).
+
+-spec compress(pid(), iodata() | undefined) -> {error, any()} |
+                                               {ok, ejabberd_zlib:zlib_socket()}.
+
+compress(Pid, Data) -> do_call(Pid, {compress, Data}).
+
+-spec become_controller(pid(), pid()) -> ok | {error, any()}.
 
 become_controller(Pid, C2SPid) ->
     do_call(Pid, {become_controller, C2SPid}).
 
-close(Pid) ->
-    gen_server:cast(Pid, close).
+-spec change_controller(pid(), pid()) -> ok | {error, any()}.
+
+change_controller(Pid, C2SPid) ->
+    do_call(Pid, {change_controller, C2SPid}).
+
+-spec setopts(pid(), list()) -> ok | {error, any()}.
+
+setopts(Pid, Opts) ->
+    case lists:member({active, false}, Opts) of
+      true ->
+            do_call(Pid, deactivate_socket);
+      false -> ok
+    end.
+
+-spec send(pid(), iodata()) -> ok | {error, any()}.
+
+send(Pid, Data) -> do_call(Pid, {send, Data}).
+
+-spec close(pid()) -> ok.
+
+close(Pid) -> gen_server:cast(Pid, close).
 
 %%====================================================================
 %% gen_server callbacks
 %%====================================================================
 
-%%--------------------------------------------------------------------
-%% Function: init(Args) -> {ok, State} |
-%%                         {ok, State, Timeout} |
-%%                         ignore               |
-%%                         {stop, Reason}
-%% Description: Initiates the server
-%%--------------------------------------------------------------------
 init([Socket, SockMod, Shaper, MaxStanzaSize]) ->
     ShaperState = shaper:new(Shaper),
     Timeout = case SockMod of
-		  ssl ->
-		      20;
-		  _ ->
-		      infinity
+		ssl -> 20;
+		_ -> infinity
 	      end,
-    {ok, #state{socket = Socket,
-		sock_mod = SockMod,
-		shaper_state = ShaperState,
-		max_stanza_size = MaxStanzaSize,
-		timeout = Timeout}}.
+    {ok,
+     #state{socket = Socket, sock_mod = SockMod,
+	    shaper_state = ShaperState,
+	    max_stanza_size = MaxStanzaSize, timeout = Timeout}}.
 
-%%--------------------------------------------------------------------
-%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
-%%                                      {reply, Reply, State, Timeout} |
-%%                                      {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, Reply, State} |
-%%                                      {stop, Reason, State}
-%% Description: Handling call messages
-%%--------------------------------------------------------------------
-handle_call({starttls, TLSSocket}, _From,
+handle_call({starttls, TLSOpts, Data}, _From,
 	    #state{xml_stream_state = XMLStreamState,
-		   c2s_pid = C2SPid,
-		   max_stanza_size = MaxStanzaSize} = State) ->
+		   c2s_pid = C2SPid, socket = Socket,
+		   max_stanza_size = MaxStanzaSize} =
+		State) ->
+    {ok, TLSSocket} = tls:tcp_to_tls(Socket, TLSOpts),
+    if Data /= undefined -> do_send(State, Data);
+       true -> ok
+    end,
     close_stream(XMLStreamState),
-    NewXMLStreamState = xml_stream:new(C2SPid, MaxStanzaSize),
+    NewXMLStreamState = xml_stream:new(C2SPid,
+				       MaxStanzaSize),
     NewState = State#state{socket = TLSSocket,
 			   sock_mod = tls,
 			   xml_stream_state = NewXMLStreamState},
-    case tls:recv_data(TLSSocket, "") of
-	{ok, TLSData} ->
-	    {reply, ok, process_data(TLSData, NewState), ?HIBERNATE_TIMEOUT};
-	{error, _Reason} ->
-	    {stop, normal, ok, NewState}
+    case tls:recv_data(TLSSocket, <<"">>) of
+      {ok, TLSData} ->
+	  {reply, {ok, TLSSocket},
+	   process_data(TLSData, NewState), ?HIBERNATE_TIMEOUT};
+      {error, _Reason} -> {stop, normal, ok, NewState}
     end;
-handle_call({compress, ZlibSocket}, _From,
+handle_call({compress, Data}, _From,
 	    #state{xml_stream_state = XMLStreamState,
-		   c2s_pid = C2SPid,
-		   max_stanza_size = MaxStanzaSize} = State) ->
+		   c2s_pid = C2SPid, socket = Socket, sock_mod = SockMod,
+		   max_stanza_size = MaxStanzaSize} =
+		State) ->
+    {ok, ZlibSocket} = ejabberd_zlib:enable_zlib(SockMod,
+						 Socket),
+    if Data /= undefined -> do_send(State, Data);
+       true -> ok
+    end,
     close_stream(XMLStreamState),
-    NewXMLStreamState = xml_stream:new(C2SPid, MaxStanzaSize),
+    NewXMLStreamState = xml_stream:new(C2SPid,
+				       MaxStanzaSize),
     NewState = State#state{socket = ZlibSocket,
 			   sock_mod = ejabberd_zlib,
 			   xml_stream_state = NewXMLStreamState},
-    case ejabberd_zlib:recv_data(ZlibSocket, "") of
-	{ok, ZlibData} ->
-	    {reply, ok, process_data(ZlibData, NewState), ?HIBERNATE_TIMEOUT};
-	{error, _Reason} ->
-	    {stop, normal, ok, NewState}
+    case ejabberd_zlib:recv_data(ZlibSocket, <<"">>) of
+      {ok, ZlibData} ->
+	  {reply, {ok, ZlibSocket},
+	   process_data(ZlibData, NewState), ?HIBERNATE_TIMEOUT};
+      {error, _Reason} -> {stop, normal, ok, NewState}
     end;
 handle_call(reset_stream, _From,
 	    #state{xml_stream_state = XMLStreamState,
-		   c2s_pid = C2SPid,
-		   max_stanza_size = MaxStanzaSize} = State) ->
+		   c2s_pid = C2SPid, max_stanza_size = MaxStanzaSize} =
+		State) ->
     close_stream(XMLStreamState),
-    NewXMLStreamState = xml_stream:new(C2SPid, MaxStanzaSize),
+    NewXMLStreamState = xml_stream:new(C2SPid,
+				       MaxStanzaSize),
     Reply = ok,
-    {reply, Reply, State#state{xml_stream_state = NewXMLStreamState},
+    {reply, Reply,
+     State#state{xml_stream_state = NewXMLStreamState},
      ?HIBERNATE_TIMEOUT};
-handle_call({become_controller, C2SPid}, _From, State) ->
-    XMLStreamState = xml_stream:new(C2SPid, State#state.max_stanza_size),
+handle_call({become_controller, C2SPid}, _From,
+	    State) ->
+    erlang:monitor(process, C2SPid),
+    XMLStreamState = xml_stream:new(C2SPid,
+				    State#state.max_stanza_size),
     NewState = State#state{c2s_pid = C2SPid,
 			   xml_stream_state = XMLStreamState},
     activate_socket(NewState),
     Reply = ok,
     {reply, Reply, NewState, ?HIBERNATE_TIMEOUT};
+handle_call({change_controller, C2SPid}, _From,
+	    State) ->
+    erlang:monitor(process, C2SPid),
+    NewXMLStreamState =
+	xml_stream:change_callback_pid(State#state.xml_stream_state,
+				       C2SPid),
+    NewState = State#state{c2s_pid = C2SPid,
+			   xml_stream_state = NewXMLStreamState},
+    activate_socket(NewState),
+    {reply, ok, NewState, ?HIBERNATE_TIMEOUT};
+handle_call({send, Data}, _From, State) ->
+    case do_send(State, Data) of
+      ok -> {reply, ok, State, ?HIBERNATE_TIMEOUT};
+      {error, _Reason} = Err -> {stop, normal, Err, State}
+    end;
+handle_call(deactivate_socket, _From, State) ->
+    deactivate_socket(State),
+    {reply, ok, State, ?HIBERNATE_TIMEOUT};
 handle_call(_Request, _From, State) ->
-    Reply = ok,
-    {reply, Reply, State, ?HIBERNATE_TIMEOUT}.
+    Reply = ok, {reply, Reply, State, ?HIBERNATE_TIMEOUT}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, State}
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
 handle_cast({change_shaper, Shaper}, State) ->
     NewShaperState = shaper:new(Shaper),
-    {noreply, State#state{shaper_state = NewShaperState}, ?HIBERNATE_TIMEOUT};
-handle_cast(close, State) ->
-    {stop, normal, State};
+    {noreply, State#state{shaper_state = NewShaperState},
+     ?HIBERNATE_TIMEOUT};
+handle_cast(close, State) -> {stop, normal, State};
 handle_cast(_Msg, State) ->
     {noreply, State, ?HIBERNATE_TIMEOUT}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%%                                       {noreply, State, Timeout} |
-%%                                       {stop, Reason, State}
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
 handle_info({Tag, _TCPSocket, Data},
-	    #state{socket = Socket,
-		   sock_mod = SockMod} = State)
-  when (Tag == tcp) or (Tag == ssl) or (Tag == ejabberd_xml) ->
+	    #state{socket = Socket, sock_mod = SockMod} = State)
+    when (Tag == tcp) or (Tag == ssl) or
+	   (Tag == ejabberd_xml) ->
     case SockMod of
-	tls ->
-	    case tls:recv_data(Socket, Data) of
-		{ok, TLSData} ->
-		    {noreply, process_data(TLSData, State),
-		     ?HIBERNATE_TIMEOUT};
-		{error, _Reason} ->
-		    {stop, normal, State}
-	    end;
-	ejabberd_zlib ->
-	    case ejabberd_zlib:recv_data(Socket, Data) of
-		{ok, ZlibData} ->
-		    {noreply, process_data(ZlibData, State),
-		     ?HIBERNATE_TIMEOUT};
-		{error, _Reason} ->
-		    {stop, normal, State}
-	    end;
-	_ ->
-	    {noreply, process_data(Data, State), ?HIBERNATE_TIMEOUT}
+      tls ->
+	  case tls:recv_data(Socket, Data) of
+	    {ok, TLSData} ->
+		{noreply, process_data(TLSData, State),
+		 ?HIBERNATE_TIMEOUT};
+	    {error, _Reason} -> {stop, normal, State}
+	  end;
+      ejabberd_zlib ->
+	  case ejabberd_zlib:recv_data(Socket, Data) of
+	    {ok, ZlibData} ->
+		{noreply, process_data(ZlibData, State),
+		 ?HIBERNATE_TIMEOUT};
+	    {error, _Reason} -> {stop, normal, State}
+	  end;
+      _ ->
+	  {noreply, process_data(Data, State), ?HIBERNATE_TIMEOUT}
     end;
 handle_info({Tag, _TCPSocket}, State)
-  when (Tag == tcp_closed) or (Tag == ssl_closed) ->
+    when (Tag == tcp_closed) or (Tag == ssl_closed) ->
     {stop, normal, State};
 handle_info({Tag, _TCPSocket, Reason}, State)
-  when (Tag == tcp_error) or (Tag == ssl_error) ->
+    when (Tag == tcp_error) or (Tag == ssl_error) ->
     case Reason of
-	timeout ->
-	    {noreply, State, ?HIBERNATE_TIMEOUT};
-	_ ->
-	    {stop, normal, State}
+      timeout -> {noreply, State, ?HIBERNATE_TIMEOUT};
+      _ -> {stop, normal, State}
     end;
+handle_info({'DOWN', _MRef, process, C2SPid, _},
+	    #state{c2s_pid = C2SPid} = State) ->
+    {stop, normal, State};
 handle_info({timeout, _Ref, activate}, State) ->
     activate_socket(State),
     {noreply, State, ?HIBERNATE_TIMEOUT};
 handle_info(timeout, State) ->
-    proc_lib:hibernate(gen_server, enter_loop, [?MODULE, [], State]),
+    proc_lib:hibernate(gen_server, enter_loop,
+		       [?MODULE, [], State]),
     {noreply, State, ?HIBERNATE_TIMEOUT};
 handle_info(_Info, State) ->
     {noreply, State, ?HIBERNATE_TIMEOUT}.
 
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> void()
-%% Description: This function is called by a gen_server when it is about to
-%% terminate. It should be the opposite of Module:init/1 and do any necessary
-%% cleaning up. When it returns, the gen_server terminates with Reason.
-%% The return value is ignored.
-%%--------------------------------------------------------------------
-terminate(_Reason, #state{xml_stream_state = XMLStreamState,
-			  c2s_pid = C2SPid} = State) ->
+terminate(_Reason,
+	  #state{xml_stream_state = XMLStreamState,
+		 c2s_pid = C2SPid} =
+	      State) ->
     close_stream(XMLStreamState),
-    if
-	C2SPid /= undefined ->
-	    gen_fsm:send_event(C2SPid, closed);
-	true ->
-	    ok
+    if C2SPid /= undefined ->
+	   gen_fsm:send_event(C2SPid, closed);
+       true -> ok
     end,
     catch (State#state.sock_mod):close(State#state.socket),
     ok.
 
-%%--------------------------------------------------------------------
-%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
-    {ok, State}.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
 
 %%--------------------------------------------------------------------
 %%% Internal functions
@@ -278,78 +301,81 @@ code_change(_OldVsn, State, _Extra) ->
 
 activate_socket(#state{socket = Socket,
 		       sock_mod = SockMod}) ->
-    PeerName =
-	case SockMod of
-	    gen_tcp ->
-		inet:setopts(Socket, [{active, once}]),
-		inet:peername(Socket);
-	    _ ->
-		SockMod:setopts(Socket, [{active, once}]),
-		SockMod:peername(Socket)
-	end,
+    PeerName = case SockMod of
+		 gen_tcp ->
+		     inet:setopts(Socket, [{active, once}]),
+		     inet:peername(Socket);
+		 _ ->
+		     SockMod:setopts(Socket, [{active, once}]),
+		     SockMod:peername(Socket)
+	       end,
     case PeerName of
-	{error, _Reason} ->
-	    self() ! {tcp_closed, Socket};
-	{ok, _} ->
-	    ok
+      {error, _Reason} -> self() ! {tcp_closed, Socket};
+      {ok, _} -> ok
+    end.
+
+deactivate_socket(#state{socket = Socket, tref = TRef,
+			 sock_mod = SockMod}) ->
+    cancel_timer(TRef),
+    case SockMod of
+      gen_tcp -> inet:setopts(Socket, [{active, false}]);
+      _ -> SockMod:setopts(Socket, [{active, false}])
     end.
 
-%% Data processing for connectors directly generating xmlelement in
-%% Erlang data structure.
-%% WARNING: Shaper does not work with Erlang data structure.
 process_data([], State) ->
-    activate_socket(State),
-    State;
-process_data([Element|Els], #state{c2s_pid = C2SPid} = State)
-  when element(1, Element) == xmlelement;
-       element(1, Element) == xmlstreamstart;
-      element(1, Element) == xmlstreamelement;
-       element(1, Element) == xmlstreamend ->
-    if
-	C2SPid == undefined ->
-	    State;
-	true ->
-	    catch gen_fsm:send_event(C2SPid, element_wrapper(Element)),
-	    process_data(Els, State)
+    activate_socket(State), State;
+process_data([Element | Els],
+	     #state{c2s_pid = C2SPid} = State)
+    when element(1, Element) == xmlel;
+	 element(1, Element) == xmlstreamstart;
+	 element(1, Element) == xmlstreamelement;
+	 element(1, Element) == xmlstreamend ->
+    if C2SPid == undefined -> State;
+       true ->
+	   catch gen_fsm:send_event(C2SPid,
+				    element_wrapper(Element)),
+	   process_data(Els, State)
     end;
 %% Data processing for connectors receivind data as string.
 process_data(Data,
-	     #state{xml_stream_state = XMLStreamState,
-		    shaper_state = ShaperState,
-		    c2s_pid = C2SPid} = State) ->
-    ?DEBUG("Received XML on stream = ~p", [binary_to_list(Data)]),
-    XMLStreamState1 = xml_stream:parse(XMLStreamState, Data),
-    {NewShaperState, Pause} = shaper:update(ShaperState, size(Data)),
-    if
-	C2SPid == undefined ->
-	    ok;
-	Pause > 0 ->
-	    erlang:start_timer(Pause, self(), activate);
-	true ->
-	    activate_socket(State)
-    end,
+	     #state{xml_stream_state = XMLStreamState, tref = TRef,
+		    shaper_state = ShaperState, c2s_pid = C2SPid} =
+		 State) ->
+    ?DEBUG("Received XML on stream = ~p", [(Data)]),
+    XMLStreamState1 = xml_stream:parse(XMLStreamState,
+				       Data),
+    {NewShaperState, Pause} = shaper:update(ShaperState,
+					    byte_size(Data)),
+    NewTRef = if C2SPid == undefined -> TRef;
+		 Pause > 0 ->
+		     erlang:start_timer(Pause, self(), activate);
+		 true -> activate_socket(State), TRef
+	      end,
     State#state{xml_stream_state = XMLStreamState1,
-		shaper_state = NewShaperState}.
+		tref = NewTRef, shaper_state = NewShaperState}.
 
-%% Element coming from XML parser are wrapped inside xmlstreamelement
-%% When we receive directly xmlelement tuple (from a socket module
-%% speaking directly Erlang XML), we wrap it inside the same
-%% xmlstreamelement coming from the XML parser.
 element_wrapper(XMLElement)
-  when element(1, XMLElement) == xmlelement ->
+    when element(1, XMLElement) == xmlel ->
     {xmlstreamelement, XMLElement};
-element_wrapper(Element) ->
-    Element.
+element_wrapper(Element) -> Element.
 
-close_stream(undefined) ->
-    ok;
+close_stream(undefined) -> ok;
 close_stream(XMLStreamState) ->
     xml_stream:close(XMLStreamState).
 
+do_send(State, Data) ->
+    (State#state.sock_mod):send(State#state.socket, Data).
+
+cancel_timer(TRef) when is_reference(TRef) ->
+    case erlang:cancel_timer(TRef) of
+      false ->
+	  receive {timeout, TRef, _} -> ok after 0 -> ok end;
+      _ -> ok
+    end;
+cancel_timer(_) -> ok.
+
 do_call(Pid, Msg) ->
     case catch gen_server:call(Pid, Msg) of
-        {'EXIT', Why} ->
-            {error, Why};
-        Res ->
-            Res
+      {'EXIT', Why} -> {error, Why};
+      Res -> Res
     end.

src/ejabberd_regexp.erl

@@ -5,7 +5,7 @@
 %%% Created : 8 Dec 2011 by Badlop
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,48 +25,72 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_regexp).
+
 -compile([export_all]).
 
-exec(ReM, ReF, ReA, RgM, RgF, RgA) ->
-    try apply(ReM, ReF, ReA)
-    catch
-	error:undef ->
-	    apply(RgM, RgF, RgA);
-	A:B ->
-	    {error, {A, B}}
+exec({ReM, ReF, ReA}, {RgM, RgF, RgA}) ->
+    try apply(ReM, ReF, ReA) catch
+      error:undef -> apply(RgM, RgF, RgA);
+      A:B -> {error, {A, B}}
     end.
 
+-spec run(binary(), binary()) -> match | nomatch | {error, any()}.
+
 run(String, Regexp) ->
-    case exec(re, run, [String, Regexp, [{capture, none}]], regexp, first_match, [String, Regexp]) of
-	{match, _, _} -> match;
-	{match, _} -> match;
-	match -> match;
-	nomatch -> nomatch;
-	{error, Error} -> {error, Error}
+    case exec({re, run, [String, Regexp, [{capture, none}]]},
+	      {regexp, first_match, [binary_to_list(String),
+                                     binary_to_list(Regexp)]})
+	of
+      {match, _, _} -> match;
+      {match, _} -> match;
+      match -> match;
+      nomatch -> nomatch;
+      {error, Error} -> {error, Error}
     end.
 
+-spec split(binary(), binary()) -> [binary()].
+
 split(String, Regexp) ->
-    case exec(re, split, [String, Regexp, [{return, list}]], regexp, split, [String, Regexp]) of
-	{ok, FieldList} -> FieldList;
-	{error, Error} -> throw(Error);
-	A -> A
+    case exec({re, split, [String, Regexp, [{return, binary}]]},
+	      {regexp, split, [binary_to_list(String),
+                               binary_to_list(Regexp)]})
+	of
+      {ok, FieldList} -> [iolist_to_binary(F) || F <- FieldList];
+      {error, Error} -> throw(Error);
+      A -> A
     end.
 
+-spec replace(binary(), binary(), binary()) -> binary().
+
 replace(String, Regexp, New) ->
-    case exec(re, replace, [String, Regexp, New, [{return, list}]], regexp, sub, [String, Regexp, New]) of
-	{ok, NewString, _RepCount} -> NewString;
-	{error, Error} -> throw(Error);
-	A -> A
+    case exec({re, replace, [String, Regexp, New, [{return, binary}]]},
+              {regexp, sub, [binary_to_list(String),
+                             binary_to_list(Regexp),
+                             binary_to_list(New)]})
+	of
+      {ok, NewString, _RepCount} -> iolist_to_binary(NewString);
+      {error, Error} -> throw(Error);
+      A -> A
     end.
 
+-spec greplace(binary(), binary(), binary()) -> binary().
+
 greplace(String, Regexp, New) ->
-    case exec(re, replace, [String, Regexp, New, [global, {return, list}]], regexp, sub, [String, Regexp, New]) of
-	{ok, NewString, _RepCount} -> NewString;
-	{error, Error} -> throw(Error);
-	A -> A
+    case exec({re, replace, [String, Regexp, New, [global, {return, binary}]]},
+              {regexp, sub, [binary_to_list(String),
+                             binary_to_list(Regexp),
+                             binary_to_list(New)]})
+	of
+      {ok, NewString, _RepCount} -> iolist_to_binary(NewString);
+      {error, Error} -> throw(Error);
+      A -> A
     end.
 
+-spec sh_to_awk(binary()) -> binary().
+
 sh_to_awk(ShRegExp) ->
-    case exec(xmerl_regexp, sh_to_awk, [ShRegExp], regexp, sh_to_awk, [ShRegExp]) of
-	A -> A
+    case exec({xmerl_regexp, sh_to_awk, [binary_to_list(ShRegExp)]},
+              {regexp, sh_to_awk, [binary_to_list(ShRegExp)]})
+	of
+      A -> iolist_to_binary(A)
     end.

src/ejabberd_riak.erl

@@ -0,0 +1,488 @@
+%%%-------------------------------------------------------------------
+%%% @author Alexey Shchepin <alexey@process-one.net>
+%%% @doc
+%%% Interface for Riak database
+%%% @end
+%%% Created : 29 Dec 2011 by Alexey Shchepin <alexey@process-one.net>
+%%% @copyright (C) 2002-2013   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., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%-------------------------------------------------------------------
+-module(ejabberd_riak).
+
+-behaviour(gen_server).
+
+%% API
+-export([start_link/3, make_bucket/1, put/1, put/2,
+         get/1, get/2, get_by_index/3, delete/1, delete/2,
+         count_by_index/3, get_by_index_range/4,
+         get_keys/1, get_keys_by_index/3,
+         count/1, delete_by_index/3]).
+%% For debugging
+-export([get_tables/0]).
+%% map/reduce exports
+-export([map_key/3]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+         terminate/2, code_change/3]).
+
+-include("ejabberd.hrl").
+
+-record(state, {pid = self() :: pid()}).
+
+-type index() :: {binary(), any()}.
+
+-type index_info() :: [{i, any()} | {'2i', [index()]}].
+
+%% The `index_info()' is used in put/delete functions:
+%% `i' defines a primary index, `` '2i' '' defines secondary indexes.
+%% There must be only one primary index. If `i' is not specified,
+%% the first element of the record is assumed as a primary index,
+%% i.e. `i' = element(2, Record).
+
+-export_types([index_info/0]).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%% @private
+start_link(Server, Port, _StartInterval) ->
+    gen_server:start_link(?MODULE, [Server, Port], []).
+
+-spec make_bucket(atom()) -> binary().
+%% @doc Makes a bucket from a table name
+%% @private
+make_bucket(Table) ->
+    erlang:atom_to_binary(Table, utf8).
+
+-spec put(tuple()) -> ok | {error, any()}.
+%% @equiv put(Record, [])
+put(Record) ->
+    ?MODULE:put(Record, []).
+
+-spec put(tuple(), index_info()) -> ok | {error, any()}.
+%% @doc Stores a record `Rec' with indexes described in ``IndexInfo''
+put(Rec, IndexInfo) ->
+    Key = encode_key(proplists:get_value(i, IndexInfo, element(2, Rec))),
+    SecIdxs = [encode_index_key(K, V) ||
+                  {K, V} <- proplists:get_value('2i', IndexInfo, [])],
+    Table = element(1, Rec),
+    Value = term_to_binary(Rec),
+    case put_raw(Table, Key, Value, SecIdxs) of
+        ok ->
+            ok;
+        Error ->
+            log_error(Error, put, [{record, Rec},
+                                   {index_info, IndexInfo}]),
+            Error
+    end.
+
+put_raw(Table, Key, Value, Indexes) ->
+    Bucket = make_bucket(Table),
+    Obj = riakc_obj:new(Bucket, Key, Value, "application/x-erlang-term"),
+    Obj1 = if Indexes /= [] ->
+                   MetaData = dict:store(<<"index">>, Indexes, dict:new()),
+                   riakc_obj:update_metadata(Obj, MetaData);
+              true ->
+                   Obj
+           end,
+    riakc_pb_socket:put(ejabberd_riak_sup:get_random_pid(), Obj1).
+
+get_object_raw(Table, Key) ->
+    Bucket = make_bucket(Table),
+    riakc_pb_socket:get(ejabberd_riak_sup:get_random_pid(), Bucket, Key).
+
+-spec get(atom()) -> {ok, [any()]} | {error, any()}.
+%% @doc Returns all objects from table `Table'
+get(Table) ->
+    Bucket = make_bucket(Table),
+    case riakc_pb_socket:mapred(
+           ejabberd_riak_sup:get_random_pid(),
+           Bucket,
+           [{map, {modfun, riak_kv_mapreduce, map_object_value},
+             none, true}]) of
+        {ok, [{_, Objs}]} ->
+            {ok, lists:flatmap(
+                   fun(Obj) ->
+                           case catch binary_to_term(Obj) of
+                               {'EXIT', _} ->
+                                   Error = {error, make_invalid_object(Obj)},
+                                   log_error(Error, get,
+                                             [{table, Table}]),
+                                   [];
+                               Term ->
+                                   [Term]
+                           end
+                   end, Objs)};
+        {error, notfound} ->
+            {ok, []};
+        Error ->
+            Error
+    end.
+
+-spec get(atom(), any()) -> {ok, any()} | {error, any()}.
+%% @doc Reads record by `Key' from table `Table'
+get(Table, Key) ->
+    case get_raw(Table, encode_key(Key)) of
+        {ok, Val} ->
+            case catch binary_to_term(Val) of
+                {'EXIT', _} ->
+                    Error = {error, make_invalid_object(Val)},
+                    log_error(Error, get, [{table, Table}, {key, Key}]),
+                    {error, notfound};
+                Term ->
+                    {ok, Term}
+            end;
+        Error ->
+            log_error(Error, get, [{table, Table},
+                                   {key, Key}]),
+            Error
+    end.
+
+-spec get_by_index(atom(), binary(), any()) -> {ok, [any()]} | {error, any()}.
+%% @doc Reads records by `Index' and value `Key' from `Table' 
+get_by_index(Table, Index, Key) ->
+    {NewIndex, NewKey} = encode_index_key(Index, Key),
+    case get_by_index_raw(Table, NewIndex, NewKey) of
+        {ok, Vals} ->
+            {ok, lists:flatmap(
+                   fun(Val) ->
+                           case catch binary_to_term(Val) of
+                               {'EXIT', _} ->
+                                   Error = {error, make_invalid_object(Val)},
+                                   log_error(Error, get_by_index,
+                                             [{table, Table},
+                                              {index, Index},
+                                              {key, Key}]),
+                                   [];
+                               Term ->
+                                   [Term]
+                           end
+                   end, Vals)};
+        {error, notfound} ->
+            {ok, []};
+        Error ->
+            log_error(Error, get_by_index,
+                      [{table, Table},
+                       {index, Index},
+                       {key, Key}]),
+            Error
+    end.
+
+-spec get_by_index_range(atom(), binary(), any(), any()) ->
+                                {ok, [any()]} | {error, any()}.
+%% @doc Reads records by `Index' in the range `FromKey'..`ToKey' from `Table'
+get_by_index_range(Table, Index, FromKey, ToKey) ->
+    {NewIndex, NewFromKey} = encode_index_key(Index, FromKey),
+    {NewIndex, NewToKey} = encode_index_key(Index, ToKey),
+    case get_by_index_range_raw(Table, NewIndex, NewFromKey, NewToKey) of
+        {ok, Vals} ->
+            {ok, lists:flatmap(
+                   fun(Val) ->
+                           case catch binary_to_term(Val) of
+                               {'EXIT', _} ->
+                                   Error = {error, make_invalid_object(Val)},
+                                   log_error(Error, get_by_index_range,
+                                             [{table, Table},
+                                              {index, Index},
+                                              {start_key, FromKey},
+                                              {end_key, ToKey}]),
+                                   [];
+                               Term ->
+                                   [Term]
+                           end
+                   end, Vals)};
+        {error, notfound} ->
+            {ok, []};
+        Error ->
+            log_error(Error, get_by_index_range,
+                      [{table, Table}, {index, Index},
+                       {start_key, FromKey}, {end_key, ToKey}]),
+            Error
+    end.
+
+get_raw(Table, Key) ->
+    case get_object_raw(Table, Key) of
+        {ok, Obj} ->
+            {ok, riakc_obj:get_value(Obj)};
+        Error ->
+            Error
+    end.
+
+-spec get_keys(atom()) -> {ok, [any()]} | {error, any()}.
+%% @doc Returns a list of index values
+get_keys(Table) ->
+    Bucket = make_bucket(Table),
+    case riakc_pb_socket:mapred(
+           ejabberd_riak_sup:get_random_pid(),
+           Bucket,
+           [{map, {modfun, ?MODULE, map_key}, none, true}]) of
+        {ok, [{_, Keys}]} ->
+            {ok, Keys};
+        Error ->
+            log_error(Error, get_keys, [{table, Table}]),
+            Error
+    end.
+
+-spec get_keys_by_index(atom(), binary(),
+                        any()) -> {ok, [any()]} | {error, any()}.
+%% @doc Returns a list of primary keys of objects indexed by `Key'.
+get_keys_by_index(Table, Index, Key) ->
+    {NewIndex, NewKey} = encode_index_key(Index, Key),
+    Bucket = make_bucket(Table),
+    case riakc_pb_socket:mapred(
+           ejabberd_riak_sup:get_random_pid(),
+           {index, Bucket, NewIndex, NewKey},
+           [{map, {modfun, ?MODULE, map_key}, none, true}]) of
+        {ok, [{_, Keys}]} ->
+            {ok, Keys};
+        Error ->
+            log_error(Error, get_keys_by_index, [{table, Table},
+                                                 {index, Index},
+                                                 {key, Key}]),
+            Error
+    end.
+
+%% @hidden
+get_tables() ->
+    riakc_pb_socket:list_buckets(ejabberd_riak_sup:get_random_pid()).
+
+get_by_index_raw(Table, Index, Key) ->
+    Bucket = make_bucket(Table),
+    case riakc_pb_socket:mapred(
+           ejabberd_riak_sup:get_random_pid(),
+           {index, Bucket, Index, Key},
+           [{map, {modfun, riak_kv_mapreduce, map_object_value},
+             none, true}]) of
+        {ok, [{_, Objs}]} ->
+            {ok, Objs};
+        Error ->
+            Error
+    end.
+
+get_by_index_range_raw(Table, Index, FromKey, ToKey) ->
+    Bucket = make_bucket(Table),
+    case riakc_pb_socket:mapred(
+           ejabberd_riak_sup:get_random_pid(),
+           {index, Bucket, Index, FromKey, ToKey},
+           [{map, {modfun, riak_kv_mapreduce, map_object_value},
+             none, true}]) of
+        {ok, [{_, Objs}]} ->
+            {ok, Objs};
+        Error ->
+            Error
+    end.
+
+-spec count(atom()) -> {ok, non_neg_integer()} | {error, any()}.
+%% @doc Returns the number of objects in the `Table'
+count(Table) ->
+    Bucket = make_bucket(Table),
+    case riakc_pb_socket:mapred(
+           ejabberd_riak_sup:get_random_pid(),
+           Bucket,
+           [{reduce, {modfun, riak_kv_mapreduce, reduce_count_inputs},
+             none, true}]) of
+        {ok, [{_, [Cnt]}]} ->
+            {ok, Cnt};
+        Error ->
+            log_error(Error, count, [{table, Table}]),
+            Error
+    end.
+
+-spec count_by_index(atom(), binary(), any()) ->
+                            {ok, non_neg_integer()} | {error, any()}.
+%% @doc Returns the number of objects in the `Table' by index
+count_by_index(Tab, Index, Key) ->
+    {NewIndex, NewKey} = encode_index_key(Index, Key),
+    case count_by_index_raw(Tab, NewIndex, NewKey) of
+        {ok, Cnt} ->
+            {ok, Cnt};
+        {error, notfound} ->
+            {ok, 0};
+        Error ->
+            log_error(Error, count_by_index,
+                      [{table, Tab},
+                       {index, Index},
+                       {key, Key}]),
+            Error
+    end.
+
+count_by_index_raw(Table, Index, Key) ->
+    Bucket = make_bucket(Table),
+    case riakc_pb_socket:mapred(
+           ejabberd_riak_sup:get_random_pid(),
+           {index, Bucket, Index, Key},
+           [{reduce, {modfun, riak_kv_mapreduce, reduce_count_inputs},
+             none, true}]) of
+        {ok, [{_, [Cnt]}]} ->
+            {ok, Cnt};
+        Error ->
+            Error
+    end.
+
+-spec delete(tuple() | atom()) -> ok | {error, any()}.
+%% @doc Same as delete(T, []) when T is record.
+%% Or deletes all elements from table if T is atom.
+delete(Rec) when is_tuple(Rec) ->
+    delete(Rec, []);
+delete(Table) when is_atom(Table) ->
+    try
+        {ok, Keys} = ?MODULE:get_keys(Table),
+        lists:foreach(
+          fun(K) ->
+                  ok = delete(Table, K)
+          end, Keys)
+    catch _:{badmatch, Err} ->
+            Err
+    end.
+
+-spec delete(tuple() | atom(), index_info() | any()) -> ok | {error, any()}.
+%% @doc Delete an object
+delete(Rec, Opts) when is_tuple(Rec) ->
+    Table = element(1, Rec),
+    Key = proplists:get_value(i, Opts, element(2, Rec)),
+    delete(Table, Key);
+delete(Table, Key) when is_atom(Table) ->
+    case delete_raw(Table, encode_key(Key)) of
+        ok ->
+            ok;
+        Err ->
+            log_error(Err, delete, [{table, Table}, {key, Key}]),
+            Err
+    end.
+
+delete_raw(Table, Key) ->
+    Bucket = make_bucket(Table),
+    riakc_pb_socket:delete(ejabberd_riak_sup:get_random_pid(), Bucket, Key).
+
+-spec delete_by_index(atom(), binary(), any()) -> ok | {error, any()}.
+%% @doc Deletes objects by index
+delete_by_index(Table, Index, Key) ->
+    try
+        {ok, Keys} = get_keys_by_index(Table, Index, Key),
+        lists:foreach(
+          fun(K) ->
+                  ok = delete(Table, K)
+          end, Keys)
+    catch _:{badmatch, Err} ->
+            Err
+    end.
+
+%%%===================================================================
+%%% map/reduce functions
+%%%===================================================================
+%% @private
+map_key(Obj, _, _) ->
+    [case riak_object:key(Obj) of
+         <<"b_", B/binary>> ->
+             B;
+         <<"i_", B/binary>> ->
+             list_to_integer(binary_to_list(B));
+         B ->
+             erlang:binary_to_term(B)
+     end].
+
+%%%===================================================================
+%%% gen_server API
+%%%===================================================================
+%% @private
+init([Server, Port]) ->
+    case riakc_pb_socket:start(
+           Server, Port,
+           [auto_reconnect]) of
+        {ok, Pid} ->
+            erlang:monitor(process, Pid),
+            ejabberd_riak_sup:add_pid(Pid),
+            {ok, #state{pid = Pid}};
+        Err ->
+            {stop, Err}
+    end.
+
+%% @private
+handle_call(_Request, _From, State) ->
+    Reply = ok,
+    {reply, Reply, State}.
+
+%% @private
+handle_cast(_Msg, State) ->
+    {noreply, State}.
+
+%% @private
+handle_info({'DOWN', _MonitorRef, _Type, _Object, _Info}, State) ->
+    {stop, normal, State};
+handle_info(_Info, State) ->
+    ?ERROR_MSG("unexpected info: ~p", [_Info]),
+    {noreply, State}.
+
+%% @private
+terminate(_Reason, State) ->
+    ejabberd_riak_sup:remove_pid(State#state.pid),
+    ok.
+
+%% @private
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+encode_index_key(Idx, Key) when is_integer(Key) ->
+    {<<Idx/binary, "_int">>, Key};
+encode_index_key(Idx, Key) ->
+    {<<Idx/binary, "_bin">>, encode_key(Key)}.
+
+encode_key(Bin) when is_binary(Bin) ->
+    <<"b_", Bin/binary>>;
+encode_key(Int) when is_integer(Int) ->
+    <<"i_", (list_to_binary(integer_to_list(Int)))/binary>>;
+encode_key(Term) ->
+    erlang:term_to_binary(Term).
+
+log_error({error, notfound}, _, _) ->
+    ok;
+log_error({error, Why} = Err, Function, Opts) ->
+    Txt = lists:map(
+            fun({table, Table}) ->
+                    io_lib:fwrite("** Table: ~p~n", [Table]);
+               ({key, Key}) ->
+                    io_lib:fwrite("** Key: ~p~n", [Key]);
+               ({index, Index}) ->
+                    io_lib:fwrite("** Index = ~p~n", [Index]);
+               ({start_key, Key}) ->
+                    io_lib:fwrite("** Start Key: ~p~n", [Key]);
+               ({end_key, Key}) ->
+                    io_lib:fwrite("** End Key: ~p~n", [Key]);
+               ({record, Rec}) ->
+                    io_lib:fwrite("** Record = ~p~n", [Rec]);
+               ({index_info, IdxInfo}) ->
+                    io_lib:fwrite("** Index info = ~p~n", [IdxInfo]);
+               (_) ->
+                    ""
+            end, Opts),
+    ErrTxt = if is_binary(Why) ->
+                     io_lib:fwrite("** Error: ~s", [Why]);
+                true ->
+                     io_lib:fwrite("** Error: ~p", [Err])
+             end,
+    ?ERROR_MSG("database error:~n** Function: ~p~n~s~s",
+               [Function, Txt, ErrTxt]);
+log_error(_, _, _) ->
+    ok.
+
+make_invalid_object(Val) ->
+    list_to_binary(io_lib:fwrite("Invalid object: ~p", [Val])).

src/ejabberd_riak_sup.erl

@@ -0,0 +1,143 @@
+%%%----------------------------------------------------------------------
+%%% File    : ejabberd_riak_sup.erl
+%%% Author  : Alexey Shchepin <alexey@process-one.net>
+%%% Purpose : Riak connections supervisor
+%%% Created : 29 Dec 2011 by Alexey Shchepin <alexey@process-one.net>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2011   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., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-module(ejabberd_riak_sup).
+-author('alexey@process-one.net').
+
+%% API
+-export([start/0,
+         start_link/0,
+	 init/1,
+	 add_pid/1,
+	 remove_pid/1,
+	 get_pids/0,
+	 get_random_pid/0
+	]).
+
+-include("ejabberd.hrl").
+
+-define(DEFAULT_POOL_SIZE, 10).
+-define(DEFAULT_RIAK_START_INTERVAL, 30). % 30 seconds
+
+% time to wait for the supervisor to start its child before returning
+% a timeout error to the request
+-define(CONNECT_TIMEOUT, 500). % milliseconds
+
+
+-record(riak_pool, {undefined, pid}).
+
+start() ->
+    StartRiak = ejabberd_config:get_local_option(
+                  riak_server, fun(_) -> true end, false),
+    if
+        StartRiak ->
+            do_start();
+        true ->
+            ok
+    end.
+
+do_start() ->
+    SupervisorName = ?MODULE,
+    ChildSpec =
+	{SupervisorName,
+	 {?MODULE, start_link, []},
+	 transient,
+	 infinity,
+	 supervisor,
+	 [?MODULE]},
+    case supervisor:start_child(ejabberd_sup, ChildSpec) of
+	{ok, _PID} ->
+	    ok;
+	_Error ->
+	    ?ERROR_MSG("Start of supervisor ~p failed:~n~p~nRetrying...~n",
+                       [SupervisorName, _Error]),
+            timer:sleep(5000),
+	    start()
+    end.
+
+start_link() ->
+    mnesia:create_table(riak_pool,
+			[{ram_copies, [node()]},
+			 {type, bag},
+			 {local_content, true},
+			 {attributes, record_info(fields, riak_pool)}]),
+    mnesia:add_table_copy(riak_pool, node(), ram_copies),
+    F = fun() ->
+		mnesia:delete({riak_pool, undefined})
+	end,
+    mnesia:ets(F),
+    supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+init([]) ->
+    PoolSize =
+        ejabberd_config:get_local_option(
+          riak_pool_size,
+          fun(N) when is_integer(N), N >= 1 -> N end,
+          ?DEFAULT_POOL_SIZE),
+    StartInterval =
+        ejabberd_config:get_local_option(
+          riak_start_interval,
+          fun(N) when is_integer(N), N >= 1 -> N end,
+          ?DEFAULT_RIAK_START_INTERVAL),
+    {Server, Port} =
+        ejabberd_config:get_local_option(
+          riak_server,
+          fun({S, P}) when is_integer(P), P > 0, P < 65536 ->
+                  {binary_to_list(iolist_to_binary(S)), P}
+          end, {"127.0.0.1", 8081}),
+    {ok, {{one_for_one, PoolSize*10, 1},
+	  lists:map(
+	    fun(I) ->
+		    {I,
+		     {ejabberd_riak, start_link,
+                      [Server, Port, StartInterval*1000]},
+		     transient,
+                     2000,
+		     worker,
+		     [?MODULE]}
+	    end, lists:seq(1, PoolSize))}}.
+
+get_pids() ->
+    Rs = mnesia:dirty_read(riak_pool, undefined),
+    [R#riak_pool.pid || R <- Rs].
+
+get_random_pid() ->
+    Pids = get_pids(),
+    lists:nth(erlang:phash(now(), length(Pids)), Pids).
+
+add_pid(Pid) ->
+    F = fun() ->
+		mnesia:write(
+		  #riak_pool{pid = Pid})
+	end,
+    mnesia:ets(F).
+
+remove_pid(Pid) ->
+    F = fun() ->
+		mnesia:delete_object(
+		  #riak_pool{pid = Pid})
+	end,
+    mnesia:ets(F).

src/ejabberd_router.erl

@@ -5,7 +5,7 @@
 %%% Created : 27 Nov 2002 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,392 +25,372 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_router).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
 
 %% API
--export([route/3,
-	 route_error/4,
-	 register_route/1,
-	 register_route/2,
-	 register_routes/1,
-	 unregister_route/1,
-	 unregister_routes/1,
-	 dirty_get_all_routes/0,
-	 dirty_get_all_domains/0
-	]).
+-export([route/3, route_error/4, register_route/1,
+	 register_route/2, register_routes/1, unregister_route/1,
+	 unregister_routes/1, dirty_get_all_routes/0,
+	 dirty_get_all_domains/0, make_id/0, get_domain_balancing/1]).
 
 -export([start_link/0]).
 
 %% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
-	 terminate/2, code_change/3]).
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, terminate/2, code_change/3]).
 
 -include("ejabberd.hrl").
+
 -include("jlib.hrl").
 
+-type local_hint() :: undefined | integer() | {apply, atom(), atom()}.
+
 -record(route, {domain, pid, local_hint}).
+
 -record(state, {}).
 
-%%====================================================================
-%% API
-%%====================================================================
-%%--------------------------------------------------------------------
-%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
-%% Description: Starts the server
-%%--------------------------------------------------------------------
-start_link() ->
-    gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+-define(ROUTE_PREFIX, "rr-").
 
+start_link() ->
+    gen_server:start_link({local, ?MODULE}, ?MODULE, [],
+			  []).
+
+-spec route(jid(), jid(), xmlel()) -> ok.
 
 route(From, To, Packet) ->
-    case catch do_route(From, To, Packet) of
-	{'EXIT', Reason} ->
-	    ?ERROR_MSG("~p~nwhen processing: ~p",
-		       [Reason, {From, To, Packet}]);
-	_ ->
-	    ok
+    case catch route_check_id(From, To, Packet) of
+      {'EXIT', Reason} ->
+	  ?ERROR_MSG("~p~nwhen processing: ~p",
+		     [Reason, {From, To, Packet}]);
+      _ -> ok
     end.
 
-%% Route the error packet only if the originating packet is not an error itself.
-%% RFC3920 9.3.1
+-spec route_error(jid(), jid(), xmlel(), xmlel()) -> ok.
+
 route_error(From, To, ErrPacket, OrigPacket) ->
-    {xmlelement, _Name, Attrs, _Els} = OrigPacket,
-    case "error" == xml:get_attr_s("type", Attrs) of
-	false ->
-	    route(From, To, ErrPacket);
-	true ->
-	    ok
+    #xmlel{attrs = Attrs} = OrigPacket,
+    case <<"error">> == xml:get_attr_s(<<"type">>, Attrs) of
+      false -> route(From, To, ErrPacket);
+      true -> ok
     end.
 
+-spec register_route(binary()) -> term().
+
 register_route(Domain) ->
     register_route(Domain, undefined).
 
+-spec register_route(binary(), local_hint()) -> term().
+
 register_route(Domain, LocalHint) ->
     case jlib:nameprep(Domain) of
-	error ->
-	    erlang:error({invalid_domain, Domain});
-	LDomain ->
-	    Pid = self(),
-	    case get_component_number(LDomain) of
-		undefined ->
-		    F = fun() ->
-				mnesia:write(#route{domain = LDomain,
-						    pid = Pid,
-						    local_hint = LocalHint})
-			end,
-		    mnesia:transaction(F);
-		N ->
-		    F = fun() ->
-				case mnesia:wread({route, LDomain}) of
-				    [] ->
-					mnesia:write(
-					  #route{domain = LDomain,
-						 pid = Pid,
-						 local_hint = 1}),
-					lists:foreach(
-					  fun(I) ->
-						  mnesia:write(
-						    #route{domain = LDomain,
-							   pid = undefined,
-							   local_hint = I})
-					  end, lists:seq(2, N));
-				    Rs ->
-					lists:any(
-					  fun(#route{pid = undefined,
-						     local_hint = I} = R) ->
-						  mnesia:write(
-						    #route{domain = LDomain,
-							   pid = Pid,
-							   local_hint = I}),
-						  mnesia:delete_object(R),
-						  true;
-					     (_) ->
-						  false
-					  end, Rs)
-				end
-			end,
-		    mnesia:transaction(F)
-	    end
+      error -> erlang:error({invalid_domain, Domain});
+      LDomain ->
+	  Pid = self(),
+	  case get_component_number(LDomain) of
+	    undefined ->
+		F = fun () ->
+			    mnesia:write(#route{domain = LDomain, pid = Pid,
+						local_hint = LocalHint})
+		    end,
+		mnesia:transaction(F);
+	    N ->
+		F = fun () ->
+			    case mnesia:wread({route, LDomain}) of
+			      [] ->
+				  mnesia:write(#route{domain = LDomain,
+						      pid = Pid,
+						      local_hint = 1}),
+				  lists:foreach(fun (I) ->
+							mnesia:write(#route{domain
+										=
+										LDomain,
+									    pid
+										=
+										undefined,
+									    local_hint
+										=
+										I})
+						end,
+						lists:seq(2, N));
+			      Rs ->
+				  lists:any(fun (#route{pid = undefined,
+							local_hint = I} =
+						     R) ->
+						    mnesia:write(#route{domain =
+									    LDomain,
+									pid =
+									    Pid,
+									local_hint
+									    =
+									    I}),
+						    mnesia:delete_object(R),
+						    true;
+						(_) -> false
+					    end,
+					    Rs)
+			    end
+		    end,
+		mnesia:transaction(F)
+	  end
     end.
 
+-spec register_routes([binary()]) -> ok.
+
 register_routes(Domains) ->
-    lists:foreach(fun(Domain) ->
-			  register_route(Domain)
-		  end, Domains).
+    lists:foreach(fun (Domain) -> register_route(Domain)
+		  end,
+		  Domains).
+
+-spec unregister_route(binary()) -> term().
 
 unregister_route(Domain) ->
     case jlib:nameprep(Domain) of
-	error ->
-	    erlang:error({invalid_domain, Domain});
-	LDomain ->
-	    Pid = self(),
-	    case get_component_number(LDomain) of
-		undefined ->
-		    F = fun() ->
-				case mnesia:match_object(
-				       #route{domain = LDomain,
-					      pid = Pid,
-					      _ = '_'}) of
-				    [R] ->
-					mnesia:delete_object(R);
-				    _ ->
-					ok
-				end
-			end,
-		    mnesia:transaction(F);
-		_ ->
-		    F = fun() ->
-				case mnesia:match_object(#route{domain=LDomain,
-								pid = Pid,
-								_ = '_'}) of
-				    [R] ->
-					I = R#route.local_hint,
-					mnesia:write(
-					  #route{domain = LDomain,
-						 pid = undefined,
-						 local_hint = I}),
-					mnesia:delete_object(R);
-				    _ ->
-					ok
-				end
-			end,
-		    mnesia:transaction(F)
-	    end
+      error -> erlang:error({invalid_domain, Domain});
+      LDomain ->
+	  Pid = self(),
+	  case get_component_number(LDomain) of
+	    undefined ->
+		F = fun () ->
+			    case mnesia:match_object(#route{domain = LDomain,
+							    pid = Pid, _ = '_'})
+				of
+			      [R] -> mnesia:delete_object(R);
+			      _ -> ok
+			    end
+		    end,
+		mnesia:transaction(F);
+	    _ ->
+		F = fun () ->
+			    case mnesia:match_object(#route{domain = LDomain,
+							    pid = Pid, _ = '_'})
+				of
+			      [R] ->
+				  I = R#route.local_hint,
+				  mnesia:write(#route{domain = LDomain,
+						      pid = undefined,
+						      local_hint = I}),
+				  mnesia:delete_object(R);
+			      _ -> ok
+			    end
+		    end,
+		mnesia:transaction(F)
+	  end
     end.
 
-unregister_routes(Domains) ->
-    lists:foreach(fun(Domain) ->
-			  unregister_route(Domain)
-		  end, Domains).
+-spec unregister_routes([binary()]) -> ok.
 
+unregister_routes(Domains) ->
+    lists:foreach(fun (Domain) -> unregister_route(Domain)
+		  end,
+		  Domains).
+
+-spec dirty_get_all_routes() -> [binary()].
 
 dirty_get_all_routes() ->
-    lists:usort(mnesia:dirty_all_keys(route)) -- ?MYHOSTS.
+    lists:usort(mnesia:dirty_all_keys(route)) -- (?MYHOSTS).
+
+-spec dirty_get_all_domains() -> [binary()].
 
 dirty_get_all_domains() ->
     lists:usort(mnesia:dirty_all_keys(route)).
 
+-spec make_id() -> binary().
+
+make_id() ->
+    <<?ROUTE_PREFIX, (randoms:get_string())/binary,
+      "-", (ejabberd_cluster:node_id())/binary>>.
 
 %%====================================================================
 %% gen_server callbacks
 %%====================================================================
 
-%%--------------------------------------------------------------------
-%% Function: init(Args) -> {ok, State} |
-%%                         {ok, State, Timeout} |
-%%                         ignore               |
-%%                         {stop, Reason}
-%% Description: Initiates the server
-%%--------------------------------------------------------------------
 init([]) ->
     update_tables(),
     mnesia:create_table(route,
-			[{ram_copies, [node()]},
-			 {type, bag},
-			 {attributes,
-			  record_info(fields, route)}]),
+			[{ram_copies, [node()]}, {type, bag},
+			 {attributes, record_info(fields, route)}]),
     mnesia:add_table_copy(route, node(), ram_copies),
     mnesia:subscribe({table, route, simple}),
-    lists:foreach(
-      fun(Pid) ->
-	      erlang:monitor(process, Pid)
-      end,
-      mnesia:dirty_select(route, [{{route, '_', '$1', '_'}, [], ['$1']}])),
+    lists:foreach(fun (Pid) -> erlang:monitor(process, Pid)
+		  end,
+		  mnesia:dirty_select(route,
+				      [{{route, '_', '$1', '_'}, [], ['$1']}])),
     {ok, #state{}}.
 
-%%--------------------------------------------------------------------
-%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
-%%                                      {reply, Reply, State, Timeout} |
-%%                                      {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, Reply, State} |
-%%                                      {stop, Reason, State}
-%% Description: Handling call messages
-%%--------------------------------------------------------------------
 handle_call(_Request, _From, State) ->
-    Reply = ok,
-    {reply, Reply, State}.
+    Reply = ok, {reply, Reply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, State}
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
-handle_cast(_Msg, State) ->
-    {noreply, State}.
+handle_cast(_Msg, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%%                                       {noreply, State, Timeout} |
-%%                                       {stop, Reason, State}
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
 handle_info({route, From, To, Packet}, State) ->
     case catch do_route(From, To, Packet) of
-	{'EXIT', Reason} ->
-	    ?ERROR_MSG("~p~nwhen processing: ~p",
-		       [Reason, {From, To, Packet}]);
-	_ ->
-	    ok
+      {'EXIT', Reason} ->
+	  ?ERROR_MSG("~p~nwhen processing: ~p",
+		     [Reason, {From, To, Packet}]);
+      _ -> ok
     end,
     {noreply, State};
-handle_info({mnesia_table_event, {write, #route{pid = Pid}, _ActivityId}},
+handle_info({mnesia_table_event,
+	     {write, #route{pid = Pid}, _ActivityId}},
 	    State) ->
-    erlang:monitor(process, Pid),
-    {noreply, State};
+    erlang:monitor(process, Pid), {noreply, State};
 handle_info({'DOWN', _Ref, _Type, Pid, _Info}, State) ->
-    F = fun() ->
-		Es = mnesia:select(
-		       route,
-		       [{#route{pid = Pid, _ = '_'},
-			 [],
-			 ['$_']}]),
-		lists:foreach(
-		  fun(E) ->
-			  if
-			      is_integer(E#route.local_hint) ->
-				  LDomain = E#route.domain,
-				  I = E#route.local_hint,
-				  mnesia:write(
-				    #route{domain = LDomain,
-					   pid = undefined,
-					   local_hint = I}),
-				  mnesia:delete_object(E);
-			      true ->
-				  mnesia:delete_object(E)
-			  end
-		  end, Es)
+    F = fun () ->
+		Es = mnesia:select(route,
+				   [{#route{pid = Pid, _ = '_'}, [], ['$_']}]),
+		lists:foreach(fun (E) ->
+				      if is_integer(E#route.local_hint) ->
+					     LDomain = E#route.domain,
+					     I = E#route.local_hint,
+					     mnesia:write(#route{domain =
+								     LDomain,
+								 pid =
+								     undefined,
+								 local_hint =
+								     I}),
+					     mnesia:delete_object(E);
+					 true -> mnesia:delete_object(E)
+				      end
+			      end,
+			      Es)
 	end,
     mnesia:transaction(F),
     {noreply, State};
-handle_info(_Info, State) ->
-    {noreply, State}.
+handle_info(_Info, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> void()
-%% Description: This function is called by a gen_server when it is about to
-%% terminate. It should be the opposite of Module:init/1 and do any necessary
-%% cleaning up. When it returns, the gen_server terminates with Reason.
-%% The return value is ignored.
-%%--------------------------------------------------------------------
-terminate(_Reason, _State) ->
-    ok.
+terminate(_Reason, _State) -> ok.
 
-%%--------------------------------------------------------------------
-%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
-    {ok, State}.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
+
+route_check_id(From, To,
+	       #xmlel{name = <<"iq">>, attrs = Attrs} = Packet) ->
+    case xml:get_attr_s(<<"id">>, Attrs) of
+      << ?ROUTE_PREFIX, Rest/binary>> ->
+	  Type = xml:get_attr_s(<<"type">>, Attrs),
+	  if Type == <<"error">>; Type == <<"result">> ->
+		 case str:tokens(Rest, <<"-">>) of
+		   [_, NodeID] ->
+		       case ejabberd_cluster:get_node_by_id(NodeID) of
+			 Node when Node == node() -> do_route(From, To, Packet);
+			 Node ->
+			     {ejabberd_router, Node} ! {route, From, To, Packet}
+		       end;
+		   _ -> do_route(From, To, Packet)
+		 end;
+	     true -> do_route(From, To, Packet)
+	  end;
+      _ -> do_route(From, To, Packet)
+    end;
+route_check_id(From, To, Packet) ->
+    do_route(From, To, Packet).
 
-%%--------------------------------------------------------------------
-%%% Internal functions
-%%--------------------------------------------------------------------
 do_route(OrigFrom, OrigTo, OrigPacket) ->
-    ?DEBUG("route~n\tfrom ~p~n\tto ~p~n\tpacket ~p~n",
+    ?DEBUG("route~n\tfrom ~p~n\tto ~p~n\tpacket "
+	   "~p~n",
 	   [OrigFrom, OrigTo, OrigPacket]),
     case ejabberd_hooks:run_fold(filter_packet,
-				 {OrigFrom, OrigTo, OrigPacket}, []) of
-	{From, To, Packet} ->
-	    LDstDomain = To#jid.lserver,
-	    case mnesia:dirty_read(route, LDstDomain) of
-		[] ->
-		    ejabberd_s2s:route(From, To, Packet);
-		[R] ->
-		    Pid = R#route.pid,
-		    if
-			node(Pid) == node() ->
-			    case R#route.local_hint of
-				{apply, Module, Function} ->
-				    Module:Function(From, To, Packet);
-				_ ->
-				    Pid ! {route, From, To, Packet}
-			    end;
-			is_pid(Pid) ->
-			    Pid ! {route, From, To, Packet};
-			true ->
-			    drop
-		    end;
-		Rs ->
-		    Value = case ejabberd_config:get_local_option(
-				   {domain_balancing, LDstDomain}) of
-				undefined -> now();
-				random -> now();
-				source -> jlib:jid_tolower(From);
-				destination -> jlib:jid_tolower(To);
-				bare_source ->
-				    jlib:jid_remove_resource(
-				      jlib:jid_tolower(From));
-				bare_destination ->
-				    jlib:jid_remove_resource(
-				      jlib:jid_tolower(To))
-			    end,
-		    case get_component_number(LDstDomain) of
-			undefined ->
-			    case [R || R <- Rs, node(R#route.pid) == node()] of
-				[] ->
-				    R = lists:nth(erlang:phash(Value, length(Rs)), Rs),
-				    Pid = R#route.pid,
-				    if
-					is_pid(Pid) ->
-					    Pid ! {route, From, To, Packet};
-					true ->
-					    drop
-				    end;
-				LRs ->
-				    R = lists:nth(erlang:phash(Value, length(LRs)), LRs),
-				    Pid = R#route.pid,
-				    case R#route.local_hint of
-					{apply, Module, Function} ->
-					    Module:Function(From, To, Packet);
-					_ ->
-					    Pid ! {route, From, To, Packet}
-				    end
-			    end;
-			_ ->
-			    SRs = lists:ukeysort(#route.local_hint, Rs),
-			    R = lists:nth(erlang:phash(Value, length(SRs)), SRs),
+				 {OrigFrom, OrigTo, OrigPacket}, [])
+	of
+      {From, To, Packet} ->
+	  LDstDomain = To#jid.lserver,
+	  case mnesia:dirty_read(route, LDstDomain) of
+	    [] -> ejabberd_s2s:route(From, To, Packet);
+	    [R] ->
+		Pid = R#route.pid,
+		if node(Pid) == node() ->
+		       case R#route.local_hint of
+			 {apply, Module, Function} ->
+			     Module:Function(From, To, Packet);
+			 _ -> Pid ! {route, From, To, Packet}
+		       end;
+		   is_pid(Pid) -> Pid ! {route, From, To, Packet};
+		   true -> drop
+		end;
+	    Rs ->
+		Value = case get_domain_balancing(LDstDomain) of
+                            random -> now();
+                            source -> jlib:jid_tolower(From);
+                            destination -> jlib:jid_tolower(To);
+                            bare_source ->
+                                jlib:jid_remove_resource(
+                                  jlib:jid_tolower(From));
+                            bare_destination ->
+                                jlib:jid_remove_resource(
+                                  jlib:jid_tolower(To));
+                            broadcast ->
+                                broadcast
+                        end,
+		case get_component_number(LDstDomain) of
+		  _ when Value == broadcast ->
+		      lists:foreach(fun (R) ->
+					    Pid = R#route.pid,
+					    if is_pid(Pid) ->
+						   Pid !
+						     {route, From, To, Packet};
+					       true -> drop
+					    end
+				    end,
+				    Rs);
+		  undefined ->
+		      case [R || R <- Rs, node(R#route.pid) == node()] of
+			[] ->
+			    R = lists:nth(erlang:phash(Value, length(Rs)), Rs),
 			    Pid = R#route.pid,
-			    if
-				is_pid(Pid) ->
-				    Pid ! {route, From, To, Packet};
-				true ->
-				    drop
+			    if is_pid(Pid) -> Pid ! {route, From, To, Packet};
+			       true -> drop
+			    end;
+			LRs ->
+			    R = lists:nth(erlang:phash(Value, length(LRs)),
+					  LRs),
+			    Pid = R#route.pid,
+			    case R#route.local_hint of
+			      {apply, Module, Function} ->
+				  Module:Function(From, To, Packet);
+			      _ -> Pid ! {route, From, To, Packet}
 			    end
-		    end
-	    end;
-	drop ->
-	    ok
+		      end;
+		  _ ->
+		      SRs = lists:ukeysort(#route.local_hint, Rs),
+		      R = lists:nth(erlang:phash(Value, length(SRs)), SRs),
+		      Pid = R#route.pid,
+		      if is_pid(Pid) -> Pid ! {route, From, To, Packet};
+			 true -> drop
+		      end
+		end
+	  end;
+      drop -> ?DEBUG("packet dropped~n", []), ok
     end.
 
 get_component_number(LDomain) ->
-    case ejabberd_config:get_local_option(
-	   {domain_balancing_component_number, LDomain}) of
-	N when is_integer(N),
-	       N > 1 ->
-	    N;
-	_ ->
-	    undefined
-    end.
+    ejabberd_config:get_local_option(
+      {domain_balancing_component_number, LDomain},
+      fun(N) when is_integer(N), N > 1 -> N end,
+      undefined).
+
+get_domain_balancing(LDomain) ->
+    ejabberd_config:get_local_option(
+      {domain_balancing, LDomain},
+      fun(random) -> random;
+         (source) -> source;
+         (destination) -> destination;
+         (bare_source) -> bare_source;
+         (bare_destination) -> bare_destination;
+         (broadcast) -> broadcast
+      end, random).
 
 update_tables() ->
     case catch mnesia:table_info(route, attributes) of
-	[domain, node, pid] ->
-	    mnesia:delete_table(route);
-	[domain, pid] ->
-	    mnesia:delete_table(route);
-	[domain, pid, local_hint] ->
-	    ok;
-	{'EXIT', _} ->
-	    ok
+      [domain, node, pid] -> mnesia:delete_table(route);
+      [domain, pid] -> mnesia:delete_table(route);
+      [domain, pid, local_hint] -> ok;
+      {'EXIT', _} -> ok
     end,
-    case lists:member(local_route, mnesia:system_info(tables)) of
-	true ->
-	    mnesia:delete_table(local_route);
-	false ->
-	    ok
+    case lists:member(local_route,
+		      mnesia:system_info(tables))
+	of
+      true -> mnesia:delete_table(local_route);
+      false -> ok
     end.
-

src/ejabberd_router_multicast.erl

@@ -0,0 +1,213 @@
+%%%----------------------------------------------------------------------
+%%% File    : ejabberd_router_multicast.erl
+%%% Author  : Badlop <badlop@ono.com>
+%%% Purpose : Multicast router
+%%% Created : 11 Aug 2007 by Badlop <badlop@ono.com>
+%%% Id      : $Id$
+%%%----------------------------------------------------------------------
+
+-module(ejabberd_router_multicast).
+-author('alexey@sevcom.net').
+-author('badlop@ono.com').
+-vsn('$Revision$ ').
+
+-behaviour(gen_server).
+
+%% API
+-export([route_multicast/4,
+	 register_route/1,
+	 unregister_route/1
+	]).
+
+-export([start_link/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+	 terminate/2, code_change/3]).
+
+-include("ejabberd.hrl").
+-include("jlib.hrl").
+
+-record(route_multicast, {domain, pid}).
+-record(state, {}).
+
+%%====================================================================
+%% API
+%%====================================================================
+%%--------------------------------------------------------------------
+%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
+%% Description: Starts the server
+%%--------------------------------------------------------------------
+start_link() ->
+    gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+
+
+route_multicast(From, Domain, Destinations, Packet) ->
+    case catch do_route(From, Domain, Destinations, Packet) of
+	{'EXIT', Reason} ->
+	    ?ERROR_MSG("~p~nwhen processing: ~p",
+		       [Reason, {From, Domain, Destinations, Packet}]);
+	_ ->
+	    ok
+    end.
+
+register_route(Domain) ->
+    case jlib:nameprep(Domain) of
+	error ->
+	    erlang:error({invalid_domain, Domain});
+	LDomain ->
+	    Pid = self(),
+	    F = fun() ->
+			mnesia:write(#route_multicast{domain = LDomain,
+						      pid = Pid})
+		end,
+	    mnesia:transaction(F)
+    end.
+
+unregister_route(Domain) ->
+    case jlib:nameprep(Domain) of
+	error ->
+	    erlang:error({invalid_domain, Domain});
+	LDomain ->
+	    Pid = self(),
+	    F = fun() ->
+		    case mnesia:select(route_multicast,
+		       [{#route_multicast{pid = Pid, domain = LDomain, _ = '_'},
+			 [],
+			 ['$_']}]) of
+			    [R] -> mnesia:delete_object(R);
+			    _ -> ok
+		    end
+		end,
+	    mnesia:transaction(F)
+    end.
+
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% Function: init(Args) -> {ok, State} |
+%%                         {ok, State, Timeout} |
+%%                         ignore               |
+%%                         {stop, Reason}
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([]) ->
+    mnesia:create_table(route_multicast,
+			[{ram_copies, [node()]},
+			 {type, bag},
+			 {attributes,
+			  record_info(fields, route_multicast)}]),
+    mnesia:add_table_copy(route_multicast, node(), ram_copies),
+    mnesia:subscribe({table, route_multicast, simple}),
+    lists:foreach(
+      fun(Pid) ->
+	      erlang:monitor(process, Pid)
+      end,
+      mnesia:dirty_select(route_multicast, [{{route_multicast, '_', '$1'}, [], ['$1']}])),
+    {ok, #state{}}.
+
+%%--------------------------------------------------------------------
+%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
+%%                                      {reply, Reply, State, Timeout} |
+%%                                      {noreply, State} |
+%%                                      {noreply, State, Timeout} |
+%%                                      {stop, Reason, Reply, State} |
+%%                                      {stop, Reason, State}
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call(_Request, _From, State) ->
+    Reply = ok,
+    {reply, Reply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast(Msg, State) -> {noreply, State} |
+%%                                      {noreply, State, Timeout} |
+%%                                      {stop, Reason, State}
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast(_Msg, State) ->
+    {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_info(Info, State) -> {noreply, State} |
+%%                                       {noreply, State, Timeout} |
+%%                                       {stop, Reason, State}
+%% Description: Handling all non call/cast messages
+%%--------------------------------------------------------------------
+handle_info({route_multicast, From, Domain, Destinations, Packet}, State) ->
+    case catch do_route(From, Domain, Destinations, Packet) of
+	{'EXIT', Reason} ->
+	    ?ERROR_MSG("~p~nwhen processing: ~p",
+		       [Reason, {From, Domain, Destinations, Packet}]);
+	_ ->
+	    ok
+    end,
+    {noreply, State};
+handle_info({mnesia_table_event, {write, #route_multicast{pid = Pid}, _ActivityId}},
+	    State) ->
+    erlang:monitor(process, Pid),
+    {noreply, State};
+handle_info({'DOWN', _Ref, _Type, Pid, _Info}, State) ->
+    F = fun() ->
+		Es = mnesia:select(
+		       route_multicast,
+		       [{#route_multicast{pid = Pid, _ = '_'},
+			 [],
+			 ['$_']}]),
+		lists:foreach(
+		  fun(E) ->
+			  mnesia:delete_object(E)
+		  end, Es)
+	end,
+    mnesia:transaction(F),
+    {noreply, State};
+handle_info(_Info, State) ->
+    {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: terminate(Reason, State) -> void()
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(_Reason, _State) ->
+    ok.
+
+%%--------------------------------------------------------------------
+%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+%% From = #jid
+%% Destinations = [#jid]
+do_route(From, Domain, Destinations, Packet) ->
+
+    ?DEBUG("route_multicast~n\tfrom ~p~n\tdomain ~p~n\tdestinations ~p~n\tpacket ~p~n",
+	   [From, Domain, Destinations, Packet]),
+
+    %% Try to find an appropriate multicast service
+    case mnesia:dirty_read(route_multicast, Domain) of
+
+	%% If no multicast service is available in this server, send manually
+	[] -> do_route_normal(From, Destinations, Packet);
+
+	%% If available, send the packet using multicast service
+	[R] ->
+	    case R#route_multicast.pid of
+		Pid when is_pid(Pid) ->
+		    Pid ! {route_trusted, From, Destinations, Packet};
+		_ -> do_route_normal(From, Destinations, Packet)
+	    end
+    end.
+
+do_route_normal(From, Destinations, Packet) ->
+    [ejabberd_router:route(From, To, Packet) || To <- Destinations].

src/ejabberd_s2s.erl

@@ -5,7 +5,7 @@
 %%% Created :  7 Dec 2002 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,335 +25,321 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_s2s).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
 
 %% API
--export([start_link/0,
-	 route/3,
-	 have_connection/1,
-	 has_key/2,
-	 get_connections_pids/1,
-	 try_register/1,
-	 remove_connection/3,
-	 find_connection/2,
-	 dirty_get_connections/0,
-	 allow_host/2,
-	 incoming_s2s_number/0,
-	 outgoing_s2s_number/0,
+-export([start_link/0, route/3, have_connection/1,
+	 has_key/2, get_connections_pids/1, try_register/1,
+	 remove_connection/3, find_connection/2,
+	 dirty_get_connections/0, allow_host/2,
+	 incoming_s2s_number/0, outgoing_s2s_number/0,
 	 clean_temporarily_blocked_table/0,
 	 list_temporarily_blocked_hosts/0,
-	 external_host_overloaded/1,
-	 is_temporarly_blocked/1
-	]).
+         get_connections_number/1, needed_connections_number/3,
+         get_connections_number_per_node/1,
+	 external_host_overloaded/1, is_temporarly_blocked/1]).
 
 %% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
-         terminate/2, code_change/3]).
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, terminate/2, code_change/3]).
+
 %% ejabberd API
 -export([get_info_s2s_connections/1]).
 
 -include("ejabberd.hrl").
+
 -include("jlib.hrl").
+
 -include("ejabberd_commands.hrl").
 
 -define(DEFAULT_MAX_S2S_CONNECTIONS_NUMBER, 1).
+
 -define(DEFAULT_MAX_S2S_CONNECTIONS_NUMBER_PER_NODE, 1).
 
 -define(S2S_OVERLOAD_BLOCK_PERIOD, 60).
+
 %% once a server is temporarly blocked, it stay blocked for 60 seconds
 
--record(s2s, {fromto, pid, key}).
+-record(s2s, {fromto = {<<"">>, <<"">>} :: {binary(), binary()},
+              pid = self()              :: pid() | '_',
+              key = <<"">>              :: binary() | '_'}).
+
 -record(state, {}).
 
--record(temporarily_blocked, {host, timestamp}).
+-record(temporarily_blocked, {host = <<"">>     :: binary(),
+                              timestamp = now() :: erlang:timestamp()}).
+
+-type temporarily_blocked() :: #temporarily_blocked{}.
 
-%%====================================================================
-%% API
-%%====================================================================
-%%--------------------------------------------------------------------
-%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
-%% Description: Starts the server
-%%--------------------------------------------------------------------
 start_link() ->
-    gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+    gen_server:start_link({local, ?MODULE}, ?MODULE, [],
+			  []).
+
+-spec route(jid(), jid(), xmlel()) -> ok.
 
 route(From, To, Packet) ->
     case catch do_route(From, To, Packet) of
-        {'EXIT', Reason} ->
-            ?ERROR_MSG("~p~nwhen processing: ~p",
-                       [Reason, {From, To, Packet}]);
-        _ ->
-            ok
+      {'EXIT', Reason} ->
+	  ?ERROR_MSG("~p~nwhen processing: ~p",
+		     [Reason, {From, To, Packet}]);
+      _ -> ok
     end.
 
 clean_temporarily_blocked_table() ->
-	mnesia:clear_table(temporarily_blocked).
+    mnesia:clear_table(temporarily_blocked).
+
+-spec list_temporarily_blocked_hosts() -> [temporarily_blocked()].
+
 list_temporarily_blocked_hosts() ->
-	ets:tab2list(temporarily_blocked).
+    ets:tab2list(temporarily_blocked).
+
+-spec external_host_overloaded(binary()) -> {aborted, any()} | {atomic, ok}.
 
 external_host_overloaded(Host) ->
-	?INFO_MSG("Disabling connections from ~s for ~p seconds", [Host, ?S2S_OVERLOAD_BLOCK_PERIOD]),
-	mnesia:transaction( fun() ->
-		mnesia:write(#temporarily_blocked{host = Host, timestamp = now()})
-	end).
+    ?INFO_MSG("Disabling connections from ~s for ~p "
+	      "seconds",
+	      [Host, ?S2S_OVERLOAD_BLOCK_PERIOD]),
+    mnesia:transaction(fun () ->
+			       mnesia:write(#temporarily_blocked{host = Host,
+								 timestamp =
+								     now()})
+		       end).
+
+-spec is_temporarly_blocked(binary()) -> boolean().
 
 is_temporarly_blocked(Host) ->
-	case mnesia:dirty_read(temporarily_blocked, Host) of
-		[] -> false;
-		[#temporarily_blocked{timestamp = T}=Entry] ->
-			case timer:now_diff(now(), T) of
-				N when N > ?S2S_OVERLOAD_BLOCK_PERIOD * 1000 * 1000 ->
-					mnesia:dirty_delete_object(Entry),
-					false;
-				_ ->
-					true
-			end
-	end.
+    case mnesia:dirty_read(temporarily_blocked, Host) of
+      [] -> false;
+      [#temporarily_blocked{timestamp = T} = Entry] ->
+	  case timer:now_diff(now(), T) of
+	    N when N > (?S2S_OVERLOAD_BLOCK_PERIOD) * 1000 * 1000 ->
+		mnesia:dirty_delete_object(Entry), false;
+	    _ -> true
+	  end
+    end.
 
+-spec remove_connection({binary(), binary()},
+                        pid(), binary()) -> {atomic, ok} |
+                                            ok |
+                                            {aborted, any()}.
 
 remove_connection(FromTo, Pid, Key) ->
-    case catch mnesia:dirty_match_object(s2s, #s2s{fromto = FromTo,
-						   pid = Pid,
-						   _ = '_'}) of
-	[#s2s{pid = Pid, key = Key}] ->
-	    F = fun() ->
-			mnesia:delete_object(#s2s{fromto = FromTo,
-						  pid = Pid,
-						  key = Key})
-		end,
-	    mnesia:transaction(F);
-	_ ->
-	    ok
+    case catch mnesia:dirty_match_object(s2s,
+					 #s2s{fromto = FromTo, pid = Pid,
+					      _ = '_'})
+	of
+      [#s2s{pid = Pid, key = Key}] ->
+	  F = fun () ->
+		      mnesia:delete_object(#s2s{fromto = FromTo, pid = Pid,
+						key = Key})
+	      end,
+	  mnesia:transaction(F);
+      _ -> ok
     end.
 
+-spec have_connection({binary(), binary()}) -> boolean().
+
 have_connection(FromTo) ->
-    case catch mnesia:dirty_read(s2s, FromTo) of
-        [_] ->
-            true;
-        _ ->
-            false
+    case mnesia:dirty_read(s2s, FromTo) of
+      [_] -> true;
+      _ -> false
     end.
 
+-spec has_key({binary(), binary()}, binary()) -> boolean().
+
 has_key(FromTo, Key) ->
-    case mnesia:dirty_select(s2s,
-			     [{#s2s{fromto = FromTo, key = Key, _ = '_'},
-			       [],
-			       ['$_']}]) of
-	[] ->
-	    false;
-	_ ->
-	    true
+    Query = [{#s2s{fromto = FromTo, key = Key, _ = '_'}, [],
+	      ['$_']}],
+    case get_node_by_key(Key) of
+      Node when Node == node() ->
+	  case mnesia:dirty_select(s2s, Query) of
+	    [] -> false;
+	    _ -> true
+	  end;
+      Node ->
+	  case catch rpc:call(Node, mnesia, dirty_select,
+			      [s2s, Query], 5000)
+	      of
+	    [_ | _] -> true;
+	    _ -> false
+	  end
     end.
 
+-spec get_connections_pids({binary(), binary()}) -> [pid()].
+
 get_connections_pids(FromTo) ->
     case catch mnesia:dirty_read(s2s, FromTo) of
-	L when is_list(L) ->
-	    [Connection#s2s.pid || Connection <- L];
-	_ ->
-	    []
+      L when is_list(L) ->
+	  [Connection#s2s.pid || Connection <- L];
+      _ -> []
     end.
 
+-spec get_connections_number({binary(), binary()}) -> non_neg_integer().
+
+get_connections_number(FromTo) ->
+    {ResL, _BadNodes} = rpc:multicall(
+                          ejabberd_cluster:get_nodes(),
+                          ?MODULE, get_connections_number_per_node, [FromTo]),
+    lists:sum(ResL).
+
+-spec get_connections_number_per_node({binary(), binary()}) -> non_neg_integer().
+
+get_connections_number_per_node(FromTo) ->
+    ets:select_count(s2s, [{#s2s{fromto = FromTo, _ = '_'}, [], [true]}]).
+
+-spec try_register({binary(), binary()}) -> {key, binary()} | false.
+
 try_register(FromTo) ->
-    Key = randoms:get_string(),
-    MaxS2SConnectionsNumber = max_s2s_connections_number(FromTo),
+    Key = new_key(),
+    MaxS2SConnectionsNumber =
+	max_s2s_connections_number(FromTo),
     MaxS2SConnectionsNumberPerNode =
 	max_s2s_connections_number_per_node(FromTo),
-    F = fun() ->
-		L = mnesia:read({s2s, FromTo}),
-		NeededConnections = needed_connections_number(
-				      L, MaxS2SConnectionsNumber,
-				      MaxS2SConnectionsNumberPerNode),
-		if
-		    NeededConnections > 0 ->
-			mnesia:write(#s2s{fromto = FromTo,
-					  pid = self(),
-					  key = Key}),
-			{key, Key};
-		    true ->
-			false
+    NeededConnections = needed_connections_number(
+                          FromTo,
+                          MaxS2SConnectionsNumber,
+                          MaxS2SConnectionsNumberPerNode),
+    F = fun () ->
+		if NeededConnections > 0 ->
+		       mnesia:write(#s2s{fromto = FromTo, pid = self(),
+					 key = Key}),
+		       {key, Key};
+		   true -> false
 		end
 	end,
     case mnesia:transaction(F) of
-        {atomic, Res} ->
-            Res;
-        _ ->
-            false
+      {atomic, Res} -> Res;
+      _ -> false
     end.
 
+-spec dirty_get_connections() -> [{binary(), binary()}].
+
 dirty_get_connections() ->
-    mnesia:dirty_all_keys(s2s).
+    lists:flatmap(fun (Node) when Node == node() ->
+			  mnesia:dirty_all_keys(s2s);
+		      (Node) ->
+			  case catch rpc:call(Node, mnesia, dirty_all_keys,
+					      [s2s], 5000)
+			      of
+			    L when is_list(L) -> L;
+			    _ -> []
+			  end
+		  end,
+		  ejabberd_cluster:get_nodes()).
 
 %%====================================================================
 %% gen_server callbacks
 %%====================================================================
 
-%%--------------------------------------------------------------------
-%% Function: init(Args) -> {ok, State} |
-%%                         {ok, State, Timeout} |
-%%                         ignore               |
-%%                         {stop, Reason}
-%% Description: Initiates the server
-%%--------------------------------------------------------------------
 init([]) ->
     update_tables(),
-    mnesia:create_table(s2s, [{ram_copies, [node()]}, {type, bag},
-			      {attributes, record_info(fields, s2s)}]),
+    mnesia:create_table(s2s,
+			[{ram_copies, [node()]}, {type, bag},
+			 {local_content, true},
+			 {attributes, record_info(fields, s2s)}]),
     mnesia:add_table_copy(s2s, node(), ram_copies),
-    mnesia:subscribe(system),
     ejabberd_commands:register_commands(commands()),
-    mnesia:create_table(temporarily_blocked, [{ram_copies, [node()]}, {attributes, record_info(fields, temporarily_blocked)}]),
+    mnesia:create_table(temporarily_blocked,
+			[{ram_copies, [node()]},
+			 {attributes,
+			  record_info(fields, temporarily_blocked)}]),
     {ok, #state{}}.
 
-%%--------------------------------------------------------------------
-%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
-%%                                      {reply, Reply, State, Timeout} |
-%%                                      {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, Reply, State} |
-%%                                      {stop, Reason, State}
-%% Description: Handling call messages
-%%--------------------------------------------------------------------
 handle_call(_Request, _From, State) ->
-    Reply = ok,
-    {reply, Reply, State}.
+    Reply = ok, {reply, Reply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, State}
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
-handle_cast(_Msg, State) ->
-    {noreply, State}.
+handle_cast(_Msg, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%%                                       {noreply, State, Timeout} |
-%%                                       {stop, Reason, State}
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
-handle_info({mnesia_system_event, {mnesia_down, Node}}, State) ->
-    clean_table_from_bad_node(Node),
-    {noreply, State};
 handle_info({route, From, To, Packet}, State) ->
     case catch do_route(From, To, Packet) of
-        {'EXIT', Reason} ->
-            ?ERROR_MSG("~p~nwhen processing: ~p",
-                       [Reason, {From, To, Packet}]);
-        _ ->
-            ok
+      {'EXIT', Reason} ->
+	  ?ERROR_MSG("~p~nwhen processing: ~p",
+		     [Reason, {From, To, Packet}]);
+      _ -> ok
     end,
     {noreply, State};
-handle_info(_Info, State) ->
-    {noreply, State}.
+handle_info(_Info, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> void()
-%% Description: This function is called by a gen_server when it is about to
-%% terminate. It should be the opposite of Module:init/1 and do any necessary
-%% cleaning up. When it returns, the gen_server terminates with Reason.
-%% The return value is ignored.
-%%--------------------------------------------------------------------
 terminate(_Reason, _State) ->
-    ejabberd_commands:unregister_commands(commands()),
-    ok.
+    ejabberd_commands:unregister_commands(commands()), ok.
 
-%%--------------------------------------------------------------------
-%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
-    {ok, State}.
-
-%%--------------------------------------------------------------------
-%%% Internal functions
-%%--------------------------------------------------------------------
-clean_table_from_bad_node(Node) ->
-    F = fun() ->
-		Es = mnesia:select(
-		       s2s,
-		       [{#s2s{pid = '$1', _ = '_'},
-			 [{'==', {node, '$1'}, Node}],
-			 ['$_']}]),
-		lists:foreach(fun(E) ->
-				      mnesia:delete_object(E)
-			      end, Es)
-	end,
-    mnesia:async_dirty(F).
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
 
 do_route(From, To, Packet) ->
-    ?DEBUG("s2s manager~n\tfrom ~p~n\tto ~p~n\tpacket ~P~n",
-           [From, To, Packet, 8]),
+    ?DEBUG("s2s manager~n\tfrom ~p~n\tto ~p~n\tpacket "
+	   "~P~n",
+	   [From, To, Packet, 8]),
     case find_connection(From, To) of
-	{atomic, Pid} when is_pid(Pid) ->
-	    ?DEBUG("sending to process ~p~n", [Pid]),
-	    {xmlelement, Name, Attrs, Els} = Packet,
-	    NewAttrs = jlib:replace_from_to_attrs(jlib:jid_to_string(From),
-						  jlib:jid_to_string(To),
-						  Attrs),
-	    #jid{lserver = MyServer} = From,
-	    ejabberd_hooks:run(
-	      s2s_send_packet,
-	      MyServer,
-	      [From, To, Packet]),
-	    send_element(Pid, {xmlelement, Name, NewAttrs, Els}),
-	    ok;
-	{aborted, _Reason} ->
-	    case xml:get_tag_attr_s("type", Packet) of
-		"error" -> ok;
-		"result" -> ok;
-		_ ->
-		    Err = jlib:make_error_reply(
-			    Packet, ?ERR_SERVICE_UNAVAILABLE),
-		    ejabberd_router:route(To, From, Err)
-	    end,
-	    false
+      {atomic, Pid} when is_pid(Pid) ->
+	  ?DEBUG("sending to process ~p~n", [Pid]),
+	  #xmlel{name = Name, attrs = Attrs, children = Els} =
+	      Packet,
+	  NewAttrs =
+	      jlib:replace_from_to_attrs(jlib:jid_to_string(From),
+					 jlib:jid_to_string(To), Attrs),
+	  #jid{lserver = MyServer} = From,
+	  ejabberd_hooks:run(s2s_send_packet, MyServer,
+			     [From, To, Packet]),
+	  send_element(Pid,
+		       #xmlel{name = Name, attrs = NewAttrs, children = Els}),
+	  ok;
+      {aborted, _Reason} ->
+	  case xml:get_tag_attr_s(<<"type">>, Packet) of
+	    <<"error">> -> ok;
+	    <<"result">> -> ok;
+	    _ ->
+		Err = jlib:make_error_reply(Packet,
+					    ?ERR_SERVICE_UNAVAILABLE),
+		ejabberd_router:route(To, From, Err)
+	  end,
+	  false
     end.
 
+-spec find_connection(jid(), jid()) -> {aborted, any()} | {atomic, pid()}.
+
 find_connection(From, To) ->
     #jid{lserver = MyServer} = From,
     #jid{lserver = Server} = To,
     FromTo = {MyServer, Server},
-    MaxS2SConnectionsNumber = max_s2s_connections_number(FromTo),
+    MaxS2SConnectionsNumber =
+	max_s2s_connections_number(FromTo),
     MaxS2SConnectionsNumberPerNode =
 	max_s2s_connections_number_per_node(FromTo),
+    NeededConnections = needed_connections_number(
+                          FromTo,
+                          MaxS2SConnectionsNumber,
+                          MaxS2SConnectionsNumberPerNode),
     ?DEBUG("Finding connection for ~p~n", [FromTo]),
     case catch mnesia:dirty_read(s2s, FromTo) of
-	{'EXIT', Reason} ->
-	    {aborted, Reason};
-	[] ->
-	    %% We try to establish all the connections if the host is not a
-	    %% service and if the s2s host is not blacklisted or
-	    %% is in whitelist:
-	    case not is_service(From, To) andalso allow_host(MyServer, Server) of
-		true ->
-		    NeededConnections = needed_connections_number(
-					  [], MaxS2SConnectionsNumber,
-					  MaxS2SConnectionsNumberPerNode),
-		    open_several_connections(
-		      NeededConnections, MyServer,
-		      Server, From, FromTo,
-		      MaxS2SConnectionsNumber, MaxS2SConnectionsNumberPerNode);
-		false ->
-		    {aborted, error}
-	    end;
-	L when is_list(L) ->
-	    NeededConnections = needed_connections_number(
-				  L, MaxS2SConnectionsNumber,
-				  MaxS2SConnectionsNumberPerNode),
-	    if
-		NeededConnections > 0 ->
-		    %% We establish the missing connections for this pair.
-		    open_several_connections(
-		      NeededConnections, MyServer,
-		      Server, From, FromTo,
-		      MaxS2SConnectionsNumber, MaxS2SConnectionsNumberPerNode);
-		true ->
-		    %% We choose a connexion from the pool of opened ones.
-		    {atomic, choose_connection(From, L)}
-	    end
+      {'EXIT', Reason} -> {aborted, Reason};
+      [] ->
+	  %% We try to establish all the connections if the host is not a
+	  %% service and if the s2s host is not blacklisted or
+	  %% is in whitelist:
+	  case not is_service(From, To) andalso
+		 allow_host(MyServer, Server)
+	      of
+	    true ->
+		open_several_connections(NeededConnections, MyServer,
+					 Server, From, FromTo,
+					 MaxS2SConnectionsNumber,
+					 MaxS2SConnectionsNumberPerNode);
+	    false -> {aborted, error}
+	  end;
+      L when is_list(L) ->
+	  if NeededConnections > 0 ->
+		 %% We establish the missing connections for this pair.
+		 open_several_connections(NeededConnections, MyServer,
+					  Server, From, FromTo,
+					  MaxS2SConnectionsNumber,
+					  MaxS2SConnectionsNumberPerNode);
+	     true ->
+		 %% We choose a connexion from the pool of opened ones.
+		 {atomic, choose_connection(From, L)}
+	  end
     end.
 
 choose_connection(From, Connections) ->
@@ -361,127 +347,130 @@ choose_connection(From, Connections) ->
 
 choose_pid(From, Pids) ->
     Pids1 = case [P || P <- Pids, node(P) == node()] of
-		[] -> Pids;
-		Ps -> Ps
+	      [] -> Pids;
+	      Ps -> Ps
 	    end,
-    % Use sticky connections based on the JID of the sender (whithout
-    % the resource to ensure that a muc room always uses the same
-    % connection)
-    Pid = lists:nth(erlang:phash(jlib:jid_remove_resource(From), length(Pids1)),
-		    Pids1),
+    Pid =
+	lists:nth(erlang:phash(jlib:jid_remove_resource(From),
+			       length(Pids1)),
+		  Pids1),
     ?DEBUG("Using ejabberd_s2s_out ~p~n", [Pid]),
     Pid.
 
-open_several_connections(N, MyServer, Server, From, FromTo,
-			 MaxS2SConnectionsNumber,
+open_several_connections(N, MyServer, Server, From,
+			 FromTo, MaxS2SConnectionsNumber,
 			 MaxS2SConnectionsNumberPerNode) ->
-    ConnectionsResult =
-	[new_connection(MyServer, Server, From, FromTo,
-			MaxS2SConnectionsNumber, MaxS2SConnectionsNumberPerNode)
-	 || _N <- lists:seq(1, N)],
+    ConnectionsResult = [new_connection(MyServer, Server,
+					From, FromTo, MaxS2SConnectionsNumber,
+					MaxS2SConnectionsNumberPerNode)
+			 || _N <- lists:seq(1, N)],
     case [PID || {atomic, PID} <- ConnectionsResult] of
-	[] ->
-	    hd(ConnectionsResult);
-	PIDs ->
-	    {atomic, choose_pid(From, PIDs)}
+      [] -> hd(ConnectionsResult);
+      PIDs -> {atomic, choose_pid(From, PIDs)}
     end.
 
 new_connection(MyServer, Server, From, FromTo,
-	       MaxS2SConnectionsNumber, MaxS2SConnectionsNumberPerNode) ->
-    Key = randoms:get_string(),
-    {ok, Pid} = ejabberd_s2s_out:start(
-		  MyServer, Server, {new, Key}),
-    F = fun() ->
+	       MaxS2SConnectionsNumber,
+	       MaxS2SConnectionsNumberPerNode) ->
+    Key = new_key(),
+    {ok, Pid} = ejabberd_s2s_out:start(MyServer, Server,
+				       {new, Key}),
+    NeededConnections = needed_connections_number(
+                          FromTo,
+                          MaxS2SConnectionsNumber,
+                          MaxS2SConnectionsNumberPerNode),
+    F = fun () ->
 		L = mnesia:read({s2s, FromTo}),
-		NeededConnections = needed_connections_number(
-				      L, MaxS2SConnectionsNumber,
-				      MaxS2SConnectionsNumberPerNode),
-		if
-		    NeededConnections > 0 ->
-			mnesia:write(#s2s{fromto = FromTo,
-					  pid = Pid,
-					  key = Key}),
-			?INFO_MSG("New s2s connection started ~p", [Pid]),
-			Pid;
-		    true ->
-			choose_connection(From, L)
+		if NeededConnections > 0 ->
+		       mnesia:write(#s2s{fromto = FromTo, pid = Pid,
+					 key = Key}),
+		       ?INFO_MSG("New s2s connection started ~p", [Pid]),
+		       Pid;
+		   true -> choose_connection(From, L)
 		end
 	end,
     TRes = mnesia:transaction(F),
     case TRes of
-	{atomic, Pid} ->
-	    ejabberd_s2s_out:start_connection(Pid);
-	_ ->
-	    ejabberd_s2s_out:stop_connection(Pid)
+      {atomic, Pid} -> ejabberd_s2s_out:start_connection(Pid);
+      _ -> ejabberd_s2s_out:stop_connection(Pid)
     end,
     TRes.
 
 max_s2s_connections_number({From, To}) ->
-    case acl:match_rule(
-	   From, max_s2s_connections, jlib:make_jid("", To, "")) of
-	Max when is_integer(Max) -> Max;
-	_ -> ?DEFAULT_MAX_S2S_CONNECTIONS_NUMBER
+    case acl:match_rule(From, max_s2s_connections,
+			jlib:make_jid(<<"">>, To, <<"">>))
+	of
+      Max when is_integer(Max) -> Max;
+      _ -> ?DEFAULT_MAX_S2S_CONNECTIONS_NUMBER
     end.
 
 max_s2s_connections_number_per_node({From, To}) ->
-    case acl:match_rule(
-	   From, max_s2s_connections_per_node, jlib:make_jid("", To, "")) of
-	Max when is_integer(Max) -> Max;
-	_ -> ?DEFAULT_MAX_S2S_CONNECTIONS_NUMBER_PER_NODE
+    case acl:match_rule(From, max_s2s_connections_per_node,
+			jlib:make_jid(<<"">>, To, <<"">>))
+	of
+      Max when is_integer(Max) -> Max;
+      _ -> ?DEFAULT_MAX_S2S_CONNECTIONS_NUMBER_PER_NODE
     end.
 
-needed_connections_number(Ls, MaxS2SConnectionsNumber,
+needed_connections_number(FromTo,
+                          MaxS2SConnectionsNumber,
 			  MaxS2SConnectionsNumberPerNode) ->
-    LocalLs = [L || L <- Ls, node(L#s2s.pid) == node()],
-    lists:min([MaxS2SConnectionsNumber - length(Ls),
-	       MaxS2SConnectionsNumberPerNode - length(LocalLs)]).
+    lists:min(
+      [MaxS2SConnectionsNumber - get_connections_number(FromTo),
+       MaxS2SConnectionsNumberPerNode - get_connections_number_per_node(FromTo)]).
+
+new_key() ->
+    <<(randoms:get_string())/binary, "-",
+      (ejabberd_cluster:node_id())/binary>>.
+
+get_node_by_key(Key) ->
+    case str:tokens(Key, <<"-">>) of
+      [_, NodeID] -> ejabberd_cluster:get_node_by_id(NodeID);
+      _ -> node()
+    end.
 
-%%--------------------------------------------------------------------
-%% Function: is_service(From, To) -> true | false
-%% Description: Return true if the destination must be considered as a
-%% service.
-%% --------------------------------------------------------------------
 is_service(From, To) ->
     LFromDomain = From#jid.lserver,
-    case ejabberd_config:get_local_option({route_subdomains, LFromDomain}) of
-	s2s -> % bypass RFC 3920 10.3
-	    false;
-	_ ->
-	    Hosts = ?MYHOSTS,
-	    P = fun(ParentDomain) -> lists:member(ParentDomain, Hosts) end,
-	    lists:any(P, parent_domains(To#jid.lserver))
+    case ejabberd_config:get_local_option(
+           {route_subdomains, LFromDomain},
+           fun(s2s) -> s2s end) of
+      s2s -> % bypass RFC 3920 10.3
+	  false;
+      undefined ->
+	  Hosts = (?MYHOSTS),
+	  P = fun (ParentDomain) ->
+		      lists:member(ParentDomain, Hosts)
+	      end,
+	  lists:any(P, parent_domains(To#jid.lserver))
     end.
 
 parent_domains(Domain) ->
-    lists:foldl(
-      fun(Label, []) ->
-	      [Label];
-	 (Label, [Head | Tail]) ->
-	      [Label ++ "." ++ Head, Head | Tail]
-      end, [], lists:reverse(string:tokens(Domain, "."))).
-
-send_element(Pid, El) ->
-    Pid ! {send_element, El}.
+    lists:foldl(fun (Label, []) -> [Label];
+		    (Label, [Head | Tail]) ->
+			[<<Label/binary, ".", Head/binary>>, Head | Tail]
+		end,
+		[], lists:reverse(str:tokens(Domain, <<".">>))).
 
+send_element(Pid, El) -> Pid ! {send_element, El}.
 
 %%%----------------------------------------------------------------------
 %%% ejabberd commands
 
 commands() ->
-    [
-     #ejabberd_commands{name = incoming_s2s_number,
-		       tags = [stats, s2s],
-		       desc = "Number of incoming s2s connections on the node",
-		       module = ?MODULE, function = incoming_s2s_number,
-		       args = [],
-		       result = {s2s_incoming, integer}},
+    [#ejabberd_commands{name = incoming_s2s_number,
+			tags = [stats, s2s],
+			desc =
+			    "Number of incoming s2s connections on "
+			    "the node",
+			module = ?MODULE, function = incoming_s2s_number,
+			args = [], result = {s2s_incoming, integer}},
      #ejabberd_commands{name = outgoing_s2s_number,
-		       tags = [stats, s2s],
-		       desc = "Number of outgoing s2s connections on the node",
-		       module = ?MODULE, function = outgoing_s2s_number,
-		       args = [],
-		       result = {s2s_outgoing, integer}}
-    ].
+			tags = [stats, s2s],
+			desc =
+			    "Number of outgoing s2s connections on "
+			    "the node",
+			module = ?MODULE, function = outgoing_s2s_number,
+			args = [], result = {s2s_outgoing, integer}}].
 
 incoming_s2s_number() ->
     length(supervisor:which_children(ejabberd_s2s_in_sup)).
@@ -489,94 +478,97 @@ incoming_s2s_number() ->
 outgoing_s2s_number() ->
     length(supervisor:which_children(ejabberd_s2s_out_sup)).
 
-
 %%%----------------------------------------------------------------------
 %%% Update Mnesia tables
 
 update_tables() ->
     case catch mnesia:table_info(s2s, type) of
-	bag ->
-	    ok;
-	{'EXIT', _} ->
-	    ok;
-	_ ->
-	    % XXX TODO convert it ?
-	    mnesia:delete_table(s2s)
+      bag -> ok;
+      {'EXIT', _} -> ok;
+      _ -> mnesia:delete_table(s2s)
     end,
     case catch mnesia:table_info(s2s, attributes) of
-        [fromto, node, key] ->
-            mnesia:transform_table(s2s, ignore, [fromto, pid, key]),
-            mnesia:clear_table(s2s);
-        [fromto, pid, key] ->
-            ok;
-        {'EXIT', _} ->
-            ok
+      [fromto, node, key] ->
+	  mnesia:transform_table(s2s, ignore, [fromto, pid, key]),
+	  mnesia:clear_table(s2s);
+      [fromto, pid, key] -> ok;
+      {'EXIT', _} -> ok
     end,
-    case lists:member(local_s2s, mnesia:system_info(tables)) of
-        true ->
-            mnesia:delete_table(local_s2s);
-        false ->
-            ok
+    case lists:member(local_s2s, mnesia:system_info(tables))
+	of
+      true -> mnesia:delete_table(local_s2s);
+      false -> ok
+    end,
+    case catch mnesia:table_info(s2s, local_content) of
+      false -> mnesia:delete_table(s2s);
+      _ -> ok
     end.
 
-%% Check if host is in blacklist or white list
 allow_host(MyServer, S2SHost) ->
-   allow_host2(MyServer, S2SHost) andalso (not is_temporarly_blocked(S2SHost)).
+    allow_host2(MyServer, S2SHost) andalso
+      not is_temporarly_blocked(S2SHost).
 
 allow_host2(MyServer, S2SHost) ->
-    Hosts = ?MYHOSTS,
-    case lists:dropwhile(
-	   fun(ParentDomain) ->
-		   not lists:member(ParentDomain, Hosts)
-	   end, parent_domains(MyServer)) of
-	[MyHost|_] ->
-	    allow_host1(MyHost, S2SHost);
-	[] ->
-	    allow_host1(MyServer, S2SHost)
+    Hosts = (?MYHOSTS),
+    case lists:dropwhile(fun (ParentDomain) ->
+				 not lists:member(ParentDomain, Hosts)
+			 end,
+			 parent_domains(MyServer))
+	of
+      [MyHost | _] -> allow_host1(MyHost, S2SHost);
+      [] -> allow_host1(MyServer, S2SHost)
     end.
 
 allow_host1(MyHost, S2SHost) ->
-    case ejabberd_config:get_local_option({{s2s_host, S2SHost}, MyHost}) of
-	deny -> false;
-	allow -> true;
-	_ ->
-	    case ejabberd_config:get_local_option({s2s_default_policy, MyHost}) of
-		deny -> false;
-		_ ->
-		    case ejabberd_hooks:run_fold(s2s_allow_host, MyHost,
-						 allow, [MyHost, S2SHost]) of
-			deny -> false;
-			allow -> true;
-			_ -> true
-		    end
-	    end
+    case ejabberd_config:get_local_option(
+           {{s2s_host, S2SHost}, MyHost},
+           fun(deny) -> deny; (allow) -> allow end)
+	of
+      deny -> false;
+      allow -> true;
+      undefined ->
+	  case ejabberd_config:get_local_option(
+                 {s2s_default_policy, MyHost},
+                 fun(deny) -> deny; (allow) -> allow end)
+	      of
+	    deny -> false;
+	    _ ->
+		case ejabberd_hooks:run_fold(s2s_allow_host, MyHost,
+					     allow, [MyHost, S2SHost])
+		    of
+		  deny -> false;
+		  allow -> true;
+		  _ -> true
+		end
+	  end
     end.
 
-%% Get information about S2S connections of the specified type.
-%% @spec (Type) -> [Info]
-%% where Type = in | out
-%%       Info = [{InfoName::atom(), InfoValue::any()}]
+
 get_info_s2s_connections(Type) ->
     ChildType = case Type of
-		    in -> ejabberd_s2s_in_sup;
-		    out -> ejabberd_s2s_out_sup
+		  in -> ejabberd_s2s_in_sup;
+		  out -> ejabberd_s2s_out_sup
 		end,
     Connections = supervisor:which_children(ChildType),
-    get_s2s_info(Connections,Type).
+    get_s2s_info(Connections, Type).
 
-get_s2s_info(Connections,Type)->
-    complete_s2s_info(Connections,Type,[]).
-complete_s2s_info([],_,Result)->
-    Result;
-complete_s2s_info([Connection|T],Type,Result)->
-    {_,PID,_,_}=Connection,
+get_s2s_info(Connections, Type) ->
+    complete_s2s_info(Connections, Type, []).
+
+complete_s2s_info([], _, Result) -> Result;
+complete_s2s_info([Connection | T], Type, Result) ->
+    {_, PID, _, _} = Connection,
     State = get_s2s_state(PID),
-    complete_s2s_info(T,Type,[State|Result]).
+    complete_s2s_info(T, Type, [State | Result]).
 
-get_s2s_state(S2sPid)->
-    Infos = case gen_fsm:sync_send_all_state_event(S2sPid,get_state_infos) of
-		{state_infos, Is} -> [{status, open} | Is];
-		{noproc,_} -> [{status, closed}]; %% Connection closed
-		{badrpc,_} -> [{status, error}]
+-spec get_s2s_state(pid()) -> [{status, open | closed | error} | {s2s_pid, pid()}].
+
+get_s2s_state(S2sPid) ->
+    Infos = case gen_fsm:sync_send_all_state_event(S2sPid,
+						   get_state_infos)
+		of
+	      {state_infos, Is} -> [{status, open} | Is];
+	      {noproc, _} -> [{status, closed}]; %% Connection closed
+	      {badrpc, _} -> [{status, error}]
 	    end,
     [{s2s_pid, S2sPid} | Infos].

src/ejabberd_service.erl

@@ -5,7 +5,7 @@
 %%% Created :  6 Dec 2002 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,6 +25,7 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_service).
+
 -author('alexey@process-one.net').
 
 -define(GEN_FSM, p1_fsm).
@@ -32,142 +33,124 @@
 -behaviour(?GEN_FSM).
 
 %% External exports
--export([start/2,
-	 start_link/2,
-	 send_text/2,
-	 send_element/2,
-	 socket_type/0]).
+-export([start/2, start_link/2, send_text/2,
+	 send_element/2, socket_type/0]).
 
 %% gen_fsm callbacks
--export([init/1,
-	 wait_for_stream/2,
-	 wait_for_handshake/2,
-	 stream_established/2,
-	 handle_event/3,
-	 handle_sync_event/4,
-	 code_change/4,
-	 handle_info/3,
-	 terminate/3,
-     print_state/1]).
+-export([init/1, wait_for_stream/2,
+	 wait_for_handshake/2, stream_established/2,
+	 handle_event/3, handle_sync_event/4, code_change/4,
+	 handle_info/3, terminate/3, print_state/1]).
 
 -include("ejabberd.hrl").
+
 -include("jlib.hrl").
 
--record(state, {socket, sockmod, streamid,
-		hosts, password, access,
-		check_from}).
+-record(state,
+	{socket                    :: ejabberd_socket:socket_state(),
+         sockmod = ejabberd_socket :: ejabberd_socket | ejabberd_frontend_socket,
+         streamid = <<"">>         :: binary(),
+         hosts = []                :: [binary()],
+         password = <<"">>         :: binary(),
+         access                    :: atom(),
+	 check_from = true         :: boolean()}).
 
 %-define(DBGFSM, true).
 
 -ifdef(DBGFSM).
+
 -define(FSMOPTS, [{debug, [trace]}]).
+
 -else.
+
 -define(FSMOPTS, []).
+
 -endif.
 
 -define(STREAM_HEADER,
-	"<?xml version='1.0'?>"
-	"<stream:stream "
-	"xmlns:stream='http://etherx.jabber.org/streams' "
-	"xmlns='jabber:component:accept' "
-	"id='~s' from='~s'>"
-       ).
+	<<"<?xml version='1.0'?><stream:stream "
+	  "xmlns:stream='http://etherx.jabber.org/stream"
+	  "s' xmlns='jabber:component:accept' id='~s' "
+	  "from='~s'>">>).
 
--define(STREAM_TRAILER, "</stream:stream>").
+-define(STREAM_TRAILER, <<"</stream:stream>">>).
 
 -define(INVALID_HEADER_ERR,
-	"<stream:stream "
-	"xmlns:stream='http://etherx.jabber.org/streams'>"
-	"<stream:error>Invalid Stream Header</stream:error>"
-	"</stream:stream>"
-       ).
+	<<"<stream:stream xmlns:stream='http://etherx.ja"
+	  "bber.org/streams'><stream:error>Invalid "
+	  "Stream Header</stream:error></stream:stream>">>).
 
 -define(INVALID_HANDSHAKE_ERR,
-	"<stream:error>"
-	"<not-authorized xmlns='urn:ietf:params:xml:ns:xmpp-streams'/>"
-	"<text xmlns='urn:ietf:params:xml:ns:xmpp-streams' xml:lang='en'>"
-	"Invalid Handshake</text>"
-	"</stream:error>"
-	"</stream:stream>"
-       ).
+	<<"<stream:error><not-authorized xmlns='urn:ietf"
+	  ":params:xml:ns:xmpp-streams'/><text "
+	  "xmlns='urn:ietf:params:xml:ns:xmpp-streams' "
+	  "xml:lang='en'>Invalid Handshake</text></strea"
+	  "m:error></stream:stream>">>).
 
 -define(INVALID_XML_ERR,
-	xml:element_to_string(?SERR_XML_NOT_WELL_FORMED)).
--define(INVALID_NS_ERR,
-	xml:element_to_string(?SERR_INVALID_NAMESPACE)).
+	xml:element_to_binary(?SERR_XML_NOT_WELL_FORMED)).
+
+-define(INVALID_NS_ERR,
+	xml:element_to_binary(?SERR_INVALID_NAMESPACE)).
 
-%%%----------------------------------------------------------------------
-%%% API
-%%%----------------------------------------------------------------------
 start(SockData, Opts) ->
-    supervisor:start_child(ejabberd_service_sup, [SockData, Opts]).
+    supervisor:start_child(ejabberd_service_sup,
+			   [SockData, Opts]).
 
 start_link(SockData, Opts) ->
-    ?GEN_FSM:start_link(ejabberd_service, [SockData, Opts],
-			fsm_limit_opts(Opts) ++ ?FSMOPTS).
+    (?GEN_FSM):start_link(ejabberd_service,
+			  [SockData, Opts], fsm_limit_opts(Opts) ++ (?FSMOPTS)).
 
-socket_type() ->
-    xml_stream.
+socket_type() -> xml_stream.
 
 %%%----------------------------------------------------------------------
 %%% Callback functions from gen_fsm
 %%%----------------------------------------------------------------------
 
-%%----------------------------------------------------------------------
-%% Func: init/1
-%% Returns: {ok, StateName, StateData}          |
-%%          {ok, StateName, StateData, Timeout} |
-%%          ignore                              |
-%%          {stop, StopReason}
-%%----------------------------------------------------------------------
 init([{SockMod, Socket}, Opts]) ->
     ?INFO_MSG("(~w) External service connected", [Socket]),
     Access = case lists:keysearch(access, 1, Opts) of
-		 {value, {_, A}} -> A;
-		 _ -> all
+	       {value, {_, A}} -> A;
+	       _ -> all
 	     end,
-    {Hosts, Password} =
-	case lists:keysearch(hosts, 1, Opts) of
-	    {value, {_, Hs, HOpts}} ->
-		case lists:keysearch(password, 1, HOpts) of
-		    {value, {_, P}} ->
-			{Hs, P};
-		    _ ->
-			% TODO: generate error
-			false
-		end;
-	    _ ->
-		case lists:keysearch(host, 1, Opts) of
-		    {value, {_, H, HOpts}} ->
-			case lists:keysearch(password, 1, HOpts) of
-			    {value, {_, P}} ->
-				{[H], P};
-			    _ ->
-				% TODO: generate error
-				false
-			end;
-		    _ ->
-			% TODO: generate error
-			false
-		end
-	end,
+    {Hosts, Password} = case lists:keysearch(hosts, 1, Opts)
+			    of
+			  {value, {_, Hs, HOpts}} ->
+			      case lists:keysearch(password, 1, HOpts) of
+				{value, {_, P}} -> {Hs, P};
+				_ ->
+				    % TODO: generate error
+				    false
+			      end;
+			  _ ->
+			      case lists:keysearch(host, 1, Opts) of
+				{value, {_, H, HOpts}} ->
+				    case lists:keysearch(password, 1, HOpts) of
+				      {value, {_, P}} -> {[H], P};
+				      _ ->
+					  % TODO: generate error
+					  false
+				    end;
+				_ ->
+				    % TODO: generate error
+				    false
+			      end
+			end,
     Shaper = case lists:keysearch(shaper_rule, 1, Opts) of
-		 {value, {_, S}} -> S;
-		 _ -> none
-	     end,
-    CheckFrom = case lists:keysearch(service_check_from, 1, Opts) of
-		 {value, {_, CF}} -> CF;
-		 _ -> true
+	       {value, {_, S}} -> S;
+	       _ -> none
 	     end,
+    CheckFrom = case lists:keysearch(service_check_from, 1,
+				     Opts)
+		    of
+		  {value, {_, CF}} -> CF;
+		  _ -> true
+		end,
     SockMod:change_shaper(Socket, Shaper),
-    {ok, wait_for_stream, #state{socket = Socket,
-				 sockmod = SockMod,
-				 streamid = new_id(),
-				 hosts = Hosts,
-				 password = Password,
-				 access = Access,
-				 check_from = CheckFrom
-				 }}.
+    {ok, wait_for_stream,
+     #state{socket = Socket, sockmod = SockMod,
+	    streamid = new_id(), hosts = Hosts, password = Password,
+	    access = Access, check_from = CheckFrom}}.
 
 %%----------------------------------------------------------------------
 %% Func: StateName/2
@@ -176,120 +159,109 @@ init([{SockMod, Socket}, Opts]) ->
 %%          {stop, Reason, NewStateData}
 %%----------------------------------------------------------------------
 
-wait_for_stream({xmlstreamstart, _Name, Attrs}, StateData) ->
-    case xml:get_attr_s("xmlns", Attrs) of
-	"jabber:component:accept" ->
-	    %% Note: XEP-0114 requires to check that destination is a Jabber
-	    %% component served by this Jabber server.
-	    %% However several transports don't respect that,
-	    %% so ejabberd doesn't check 'to' attribute (EJAB-717)
-	    To = xml:get_attr_s("to", Attrs),
-	    Header = io_lib:format(?STREAM_HEADER,
-				   [StateData#state.streamid, xml:crypt(To)]),
-	    send_text(StateData, Header),
-	    {next_state, wait_for_handshake, StateData};
-	_ ->
-	    send_text(StateData, ?INVALID_HEADER_ERR),
-	    {stop, normal, StateData}
+wait_for_stream({xmlstreamstart, _Name, Attrs},
+		StateData) ->
+    case xml:get_attr_s(<<"xmlns">>, Attrs) of
+      <<"jabber:component:accept">> ->
+	  To = xml:get_attr_s(<<"to">>, Attrs),
+	  Header = io_lib:format(?STREAM_HEADER,
+				 [StateData#state.streamid, xml:crypt(To)]),
+	  send_text(StateData, Header),
+	  {next_state, wait_for_handshake, StateData};
+      _ ->
+	  send_text(StateData, ?INVALID_HEADER_ERR),
+	  {stop, normal, StateData}
     end;
-
 wait_for_stream({xmlstreamerror, _}, StateData) ->
     Header = io_lib:format(?STREAM_HEADER,
-			   ["none", ?MYNAME]),
+			   [<<"none">>, ?MYNAME]),
     send_text(StateData,
-	      Header ++ ?INVALID_XML_ERR ++ ?STREAM_TRAILER),
+	      <<(list_to_binary(Header))/binary, (?INVALID_XML_ERR)/binary,
+		(?STREAM_TRAILER)/binary>>),
     {stop, normal, StateData};
-
 wait_for_stream(closed, StateData) ->
     {stop, normal, StateData}.
 
-
 wait_for_handshake({xmlstreamelement, El}, StateData) ->
-    {xmlelement, Name, _Attrs, Els} = El,
+    #xmlel{name = Name, children = Els} = El,
     case {Name, xml:get_cdata(Els)} of
-	{"handshake", Digest} ->
-	    case sha:sha(StateData#state.streamid ++
-			 StateData#state.password) of
-		Digest ->
-		    send_text(StateData, "<handshake/>"),
-		    lists:foreach(
-		      fun(H) ->
-			      ejabberd_router:register_route(H),
-			      ?INFO_MSG("Route registered for service ~p~n", [H])
-		      end, StateData#state.hosts),
-		    {next_state, stream_established, StateData};
-		_ ->
-		    send_text(StateData, ?INVALID_HANDSHAKE_ERR),
-		    {stop, normal, StateData}
-	    end;
-	_ ->
-	    {next_state, wait_for_handshake, StateData}
+      {<<"handshake">>, Digest} ->
+	  case sha:sha(<<(StateData#state.streamid)/binary,
+			 (StateData#state.password)/binary>>)
+	      of
+	    Digest ->
+		send_text(StateData, <<"<handshake/>">>),
+		lists:foreach(fun (H) ->
+				      ejabberd_router:register_route(H),
+				      ?INFO_MSG("Route registered for service ~p~n",
+						[H])
+			      end,
+			      StateData#state.hosts),
+		{next_state, stream_established, StateData};
+	    _ ->
+		send_text(StateData, ?INVALID_HANDSHAKE_ERR),
+		{stop, normal, StateData}
+	  end;
+      _ -> {next_state, wait_for_handshake, StateData}
     end;
-
 wait_for_handshake({xmlstreamend, _Name}, StateData) ->
     {stop, normal, StateData};
-
 wait_for_handshake({xmlstreamerror, _}, StateData) ->
-    send_text(StateData, ?INVALID_XML_ERR ++ ?STREAM_TRAILER),
+    send_text(StateData,
+	      <<(?INVALID_XML_ERR)/binary,
+		(?STREAM_TRAILER)/binary>>),
     {stop, normal, StateData};
-
 wait_for_handshake(closed, StateData) ->
     {stop, normal, StateData}.
 
-
 stream_established({xmlstreamelement, El}, StateData) ->
-    NewEl = jlib:remove_attr("xmlns", El),
-    {xmlelement, Name, Attrs, _Els} = NewEl,
-    From = xml:get_attr_s("from", Attrs),
+    NewEl = jlib:remove_attr(<<"xmlns">>, El),
+    #xmlel{name = Name, attrs = Attrs} = NewEl,
+    From = xml:get_attr_s(<<"from">>, Attrs),
     FromJID = case StateData#state.check_from of
-		  %% If the admin does not want to check the from field
-		  %% when accept packets from any address.
-		  %% In this case, the component can send packet of
-		  %% behalf of the server users.
-		  false -> jlib:string_to_jid(From);
-		  %% The default is the standard behaviour in XEP-0114
-		  _ ->
-		      FromJID1 = jlib:string_to_jid(From),
-		      case FromJID1 of
-			  #jid{lserver = Server} ->
-			      case lists:member(Server, StateData#state.hosts) of
-				  true -> FromJID1;
-				  false -> error
-			      end;
-			  _ -> error
-		      end
+		%% If the admin does not want to check the from field
+		%% when accept packets from any address.
+		%% In this case, the component can send packet of
+		%% behalf of the server users.
+		false -> jlib:string_to_jid(From);
+		%% The default is the standard behaviour in XEP-0114
+		_ ->
+		    FromJID1 = jlib:string_to_jid(From),
+		    case FromJID1 of
+		      #jid{lserver = Server} ->
+			  case lists:member(Server, StateData#state.hosts) of
+			    true -> FromJID1;
+			    false -> error
+			  end;
+		      _ -> error
+		    end
 	      end,
-    To = xml:get_attr_s("to", Attrs),
+    To = xml:get_attr_s(<<"to">>, Attrs),
     ToJID = case To of
-		"" -> error;
-		_ -> jlib:string_to_jid(To)
+	      <<"">> -> error;
+	      _ -> jlib:string_to_jid(To)
 	    end,
-    if ((Name == "iq") or
-	(Name == "message") or
-	(Name == "presence")) and
-       (ToJID /= error) and (FromJID /= error) ->
-	    ejabberd_router:route(FromJID, ToJID, NewEl);
+    if ((Name == <<"iq">>) or (Name == <<"message">>) or
+	  (Name == <<"presence">>))
+	 and (ToJID /= error)
+	 and (FromJID /= error) ->
+	   ejabberd_router:route(FromJID, ToJID, NewEl);
        true ->
-	    Err = jlib:make_error_reply(NewEl, ?ERR_BAD_REQUEST),
-	    send_element(StateData, Err),
-	    error
+	   Err = jlib:make_error_reply(NewEl, ?ERR_BAD_REQUEST),
+	   send_element(StateData, Err),
+	   error
     end,
     {next_state, stream_established, StateData};
-
 stream_established({xmlstreamend, _Name}, StateData) ->
-    % TODO
     {stop, normal, StateData};
-
 stream_established({xmlstreamerror, _}, StateData) ->
-    send_text(StateData, ?INVALID_XML_ERR ++ ?STREAM_TRAILER),
+    send_text(StateData,
+	      <<(?INVALID_XML_ERR)/binary,
+		(?STREAM_TRAILER)/binary>>),
     {stop, normal, StateData};
-
 stream_established(closed, StateData) ->
-    % TODO
     {stop, normal, StateData}.
 
-
-
 %%----------------------------------------------------------------------
 %% Func: StateName/3
 %% Returns: {next_state, NextStateName, NextStateData}            |
@@ -303,111 +275,82 @@ stream_established(closed, StateData) ->
 %    Reply = ok,
 %    {reply, Reply, state_name, StateData}.
 
-%%----------------------------------------------------------------------
-%% Func: handle_event/3
-%% Returns: {next_state, NextStateName, NextStateData}          |
-%%          {next_state, NextStateName, NextStateData, Timeout} |
-%%          {stop, Reason, NewStateData}
-%%----------------------------------------------------------------------
 handle_event(_Event, StateName, StateData) ->
     {next_state, StateName, StateData}.
 
-%%----------------------------------------------------------------------
-%% Func: handle_sync_event/4
-%% Returns: {next_state, NextStateName, NextStateData}            |
-%%          {next_state, NextStateName, NextStateData, Timeout}   |
-%%          {reply, Reply, NextStateName, NextStateData}          |
-%%          {reply, Reply, NextStateName, NextStateData, Timeout} |
-%%          {stop, Reason, NewStateData}                          |
-%%          {stop, Reason, Reply, NewStateData}
-%%----------------------------------------------------------------------
-handle_sync_event(_Event, _From, StateName, StateData) ->
-    Reply = ok,
-    {reply, Reply, StateName, StateData}.
+handle_sync_event(_Event, _From, StateName,
+		  StateData) ->
+    Reply = ok, {reply, Reply, StateName, StateData}.
 
 code_change(_OldVsn, StateName, StateData, _Extra) ->
     {ok, StateName, StateData}.
 
-%%----------------------------------------------------------------------
-%% Func: handle_info/3
-%% Returns: {next_state, NextStateName, NextStateData}          |
-%%          {next_state, NextStateName, NextStateData, Timeout} |
-%%          {stop, Reason, NewStateData}
-%%----------------------------------------------------------------------
 handle_info({send_text, Text}, StateName, StateData) ->
     send_text(StateData, Text),
     {next_state, StateName, StateData};
 handle_info({send_element, El}, StateName, StateData) ->
     send_element(StateData, El),
     {next_state, StateName, StateData};
-handle_info({route, From, To, Packet}, StateName, StateData) ->
-    case acl:match_rule(global, StateData#state.access, From) of
-	allow ->
-	    {xmlelement, Name, Attrs, Els} = Packet,
-	    Attrs2 = jlib:replace_from_to_attrs(jlib:jid_to_string(From),
-						jlib:jid_to_string(To),
-						Attrs),
-	    Text = xml:element_to_binary({xmlelement, Name, Attrs2, Els}),
-	    send_text(StateData, Text);
-	deny ->
-	    Err = jlib:make_error_reply(Packet, ?ERR_NOT_ALLOWED),
-	    ejabberd_router:route_error(To, From, Err, Packet)
+handle_info({route, From, To, Packet}, StateName,
+	    StateData) ->
+    case acl:match_rule(global, StateData#state.access,
+			From)
+	of
+      allow ->
+	  #xmlel{name = Name, attrs = Attrs, children = Els} =
+	      Packet,
+	  Attrs2 =
+	      jlib:replace_from_to_attrs(jlib:jid_to_string(From),
+					 jlib:jid_to_string(To), Attrs),
+	  Text = xml:element_to_binary(#xmlel{name = Name,
+					      attrs = Attrs2, children = Els}),
+	  send_text(StateData, Text);
+      deny ->
+	  Err = jlib:make_error_reply(Packet, ?ERR_NOT_ALLOWED),
+	  ejabberd_router:route_error(To, From, Err, Packet)
     end,
     {next_state, StateName, StateData};
 handle_info(Info, StateName, StateData) ->
     ?ERROR_MSG("Unexpected info: ~p", [Info]),
     {next_state, StateName, StateData}.
 
-
-%%----------------------------------------------------------------------
-%% Func: terminate/3
-%% Purpose: Shutdown the fsm
-%% Returns: any
-%%----------------------------------------------------------------------
 terminate(Reason, StateName, StateData) ->
     ?INFO_MSG("terminated: ~p", [Reason]),
     case StateName of
-	stream_established ->
-	    lists:foreach(
-	      fun(H) ->
-		      ejabberd_router:unregister_route(H)
-	      end, StateData#state.hosts);
-	_ ->
-	    ok
+      stream_established ->
+	  lists:foreach(fun (H) ->
+				ejabberd_router:unregister_route(H)
+			end,
+			StateData#state.hosts);
+      _ -> ok
     end,
     (StateData#state.sockmod):close(StateData#state.socket),
     ok.
 
-%%----------------------------------------------------------------------
-%% Func: print_state/1
-%% Purpose: Prepare the state to be printed on error log
-%% Returns: State to print
-%%----------------------------------------------------------------------
-print_state(State) ->
-    State.
+print_state(State) -> State.
 
 %%%----------------------------------------------------------------------
 %%% Internal functions
 %%%----------------------------------------------------------------------
 
 send_text(StateData, Text) ->
-    (StateData#state.sockmod):send(StateData#state.socket, Text).
+    (StateData#state.sockmod):send(StateData#state.socket,
+				   Text).
 
 send_element(StateData, El) ->
     send_text(StateData, xml:element_to_binary(El)).
 
-new_id() ->
-    randoms:get_string().
+new_id() -> randoms:get_string().
 
 fsm_limit_opts(Opts) ->
     case lists:keysearch(max_fsm_queue, 1, Opts) of
-	{value, {_, N}} when is_integer(N) ->
-	    [{max_queue, N}];
-	_ ->
-	    case ejabberd_config:get_local_option(max_fsm_queue) of
-		N when is_integer(N) ->
-		    [{max_queue, N}];
-		_ ->
-		    []
-	    end
+        {value, {_, N}} when is_integer(N) ->
+            [{max_queue, N}];
+        _ ->
+            case ejabberd_config:get_local_option(
+                   max_fsm_queue,
+                   fun(I) when is_integer(I), I > 0 -> I end) of
+                undefined -> [];
+                N -> [{max_queue, N}]
+            end
     end.

src/ejabberd_sets.erl

@@ -0,0 +1,122 @@
+-module(ejabberd_sets).
+
+
+%%SET interface, same than gb_sets
+-export([
+		new/0,
+		from_list/1,
+		to_list/1,
+		is_element/2,
+		add_element/2,
+		del_element/2,
+		foldl/3,
+		size/1]).
+
+-type ej_set() :: gb_tree().
+-export_type([ej_set/0]).
+
+%% Asumptions:
+%% 		It is common that roster items are of type "both", present in both pres_a and pres_f sets.
+%% 		There are relatively few different domains in the roster.
+%% 		There are common "resource" used by users (ie, "home", "psi", "android", ..etc).
+%%
+%% Strategy:
+%% 		map of domains, pointing to map of resources,  poiting to set of usernames in that domain and with that resource.
+%%
+%% Goals:	Reduce memory usage. 
+%% 			- Sharing is explicit and evolves better than "pack()" on changes on pres_*.
+%% 			- Message passing in erlang doesn't preserve implicit sharing. With this explicit sharing, state to transfer on migrations is smaller.
+%% 			- Hopefully, less memory overhead due to pointers (storing only usernames rather than tuples of three elements.) 
+%% 			- no need to pack()
+%%
+%% 
+%% gb_tree(
+%% 	{<<"jabber.ru">>,  
+%% 			gb_tree({<<"psi">>,  set(<<"user1">>, <<"user2>>, ..)},
+%% 				{<<"resourceN">>, set(<<"someUser">>)})}
+%% 	{<<"jabber.org">>,
+%% 			gb_tree(<<"psi">>, set(<<"userA">>, <<"UserB">>))}
+%% 	...
+%%]
+
+
+
+new() ->
+	gb_trees:empty().
+from_list(L) ->
+	lists:foldl(fun add_element/2, new(), L).
+
+to_list(S) -> 
+	foldl(fun(JID, Acc) -> [JID | Acc] end, [], S).
+
+is_element({N,D,R}, S) -> 
+	case gb_trees:lookup(D, S) of
+		none -> false;
+		{value, JIDs} ->
+			case gb_trees:lookup(R, JIDs) of
+				none ->
+					false;
+				{value, Nodes} ->
+					gb_sets:is_element(N, Nodes)
+			end
+	end.
+
+
+add_element({N,D,R}, S) ->
+	case gb_trees:lookup(D, S) of
+		none ->
+			JIDs = gb_trees:insert(R, gb_sets:from_list([N]), gb_trees:empty()),
+			gb_trees:insert(D, JIDs, S);
+		{value, JIDs} ->
+			NewJIDs = case gb_trees:lookup(R, JIDs) of
+				none ->
+					gb_trees:insert(R, gb_sets:from_list([N]), JIDs);
+				{value, Nodes} ->
+					gb_trees:update(R, gb_sets:add_element(N, Nodes), JIDs)
+			end,
+			gb_trees:update(D, NewJIDs, S)
+		end.
+
+
+size(S) -> 
+	lists:foldl(fun({_Domain, JIDs}, Acc) ->
+				lists:foldl(fun({_Resource, Nodes}, Acc2) -> 
+							gb_sets:size(Nodes) + Acc2 
+					end, Acc, gb_trees:to_list(JIDs))
+		end,0, gb_trees:to_list(S)).
+
+foldl(Fun, Init, S) -> 
+	lists:foldl(fun({D,JIDs}, Acc) ->
+		lists:foldl(fun({R, Nodes}, Acc2) -> 
+				gb_sets:fold(fun(Node, Acc3) ->
+					Fun({Node,D,R}, Acc3) 
+				end, Acc2, Nodes)
+			end, Acc, gb_trees:to_list(JIDs))
+		end, Init, gb_trees:to_list(S)).
+
+del_element({N,D,R}, S) ->
+	case gb_trees:lookup(D, S) of
+		none ->
+			S;
+		{value, JIDs} ->
+			case gb_trees:lookup(R, JIDs) of
+				none ->
+					S;
+				{value, Nodes} ->
+					NewNodes = gb_sets:del_element(N, Nodes),
+					case gb_sets:is_empty(NewNodes) of  
+						true -> %%No more users in this domain with this resource
+							NewJIDs = gb_trees:delete(R, JIDs),
+							case gb_trees:is_empty(NewJIDs) of  %% No more user/resources in this domain
+								true ->
+									gb_trees:delete(D, S);
+								false ->  %%still other resources in this domain
+									gb_trees:update(D, NewJIDs, S)
+							end;
+						false ->
+							NewJIDs = gb_trees:update(R, NewNodes, JIDs),
+							gb_trees:update(D, NewJIDs, S)
+					end
+			end
+	end.
+

src/ejabberd_sm_handler.erl

@@ -0,0 +1,146 @@
+%%%----------------------------------------------------------------------
+%%% File    : ejabberd_sm.erl
+%%% Author  : Alexey Shchepin <alexey@process-one.net>
+%%% Purpose : Session manager
+%%% Created : 28 Dec 2011 by Alexey Shchepin <alexey@process-one.net>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2011   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., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-module(ejabberd_sm_handler).
+-author('alexey@process-one.net').
+
+-behaviour(gen_server).
+
+%% API
+-export([start_link/1,
+         start/1,
+         stop/1,
+         route/4]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+	 terminate/2, code_change/3]).
+
+-include("ejabberd.hrl").
+
+-record(state, {}).
+
+%%====================================================================
+%% API
+%%====================================================================
+%%--------------------------------------------------------------------
+%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
+%% Description: Starts the server
+%%--------------------------------------------------------------------
+start_link(Name) ->
+    gen_server:start_link({local, Name}, ?MODULE, [], []).
+
+start(Name) ->
+    Spec = {Name,
+            {?MODULE, start_link, [Name]},
+            permanent,
+            brutal_kill,
+            worker,
+            [?MODULE]},
+    supervisor:start_child(ejabberd_sm_sup, Spec).
+
+stop(Name) ->
+    supervisor:terminate_child(ejabberd_sm_sup, Name),
+    supervisor:delete_child(ejabberd_sm_sup, Name).
+
+route(Name, From, To, Packet) ->
+    gen_server:cast(Name, {route, From, To, Packet}).
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% Function: init(Args) -> {ok, State} |
+%%                         {ok, State, Timeout} |
+%%                         ignore               |
+%%                         {stop, Reason}
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([]) ->
+    {ok, #state{}}.
+
+%%--------------------------------------------------------------------
+%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
+%%                                      {reply, Reply, State, Timeout} |
+%%                                      {noreply, State} |
+%%                                      {noreply, State, Timeout} |
+%%                                      {stop, Reason, Reply, State} |
+%%                                      {stop, Reason, State}
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call(_Request, _From, State) ->
+    Reply = ok,
+    {reply, Reply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast(Msg, State) -> {noreply, State} |
+%%                                      {noreply, State, Timeout} |
+%%                                      {stop, Reason, State}
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast({route, From, To, Packet}, State) ->
+    case catch ejabberd_sm:do_route1(From, To, Packet) of
+        {'EXIT', Reason} ->
+            ?ERROR_MSG("~p~nwhen processing: ~p",
+                       [Reason, {From, To, Packet}]);
+        _ ->
+            ok
+    end,
+    {noreply, State};
+handle_cast(_Msg, State) ->
+    {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: handle_info(Info, State) -> {noreply, State} |
+%%                                       {noreply, State, Timeout} |
+%%                                       {stop, Reason, State}
+%% Description: Handling all non call/cast messages
+%%--------------------------------------------------------------------
+handle_info(_Info, State) ->
+    {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% Function: terminate(Reason, State) -> void()
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(_Reason, _State) ->
+    ok.
+
+%%--------------------------------------------------------------------
+%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+

src/ejabberd_sm_sup.erl

@@ -0,0 +1,35 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2012, Evgeniy Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 25 May 2012 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(ejabberd_sm_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callbacks
+-export([init/1]).
+
+-define(SERVER, ?MODULE).
+
+%%%===================================================================
+%%% API functions
+%%%===================================================================
+start_link() ->
+    supervisor:start_link({local, ?SERVER}, ?MODULE, []).
+
+%%%===================================================================
+%%% Supervisor callbacks
+%%%===================================================================
+init([]) ->
+    {ok, {{one_for_one,10,1}, []}}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================

src/ejabberd_socket.erl

@@ -5,7 +5,7 @@
 %%% Created : 23 Aug 2006 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,90 +25,93 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_socket).
+
 -author('alexey@process-one.net').
 
 %% API
--export([start/4,
-	 connect/3,
-	 connect/4,
-	 starttls/2,
-	 starttls/3,
-	 compress/1,
-	 compress/2,
-	 reset_stream/1,
-	 send/2,
-	 send_xml/2,
-	 change_shaper/2,
-	 monitor/1,
-	 get_sockmod/1,
-	 get_peer_certificate/1,
-	 get_verify_result/1,
-	 close/1,
-	 sockname/1, peername/1]).
+-export([init/0, start/4, connect/3, connect/4, starttls/2,
+	 starttls/3, compress/1, compress/2, reset_stream/1,
+	 send/2, send_xml/2, change_shaper/2, monitor/1,
+	 get_sockmod/1, get_peer_certificate/1, get_conn_type/1,
+	 get_verify_result/1, close/1, change_controller/2,
+	 change_socket/2, sockname/1, peername/1, is_remote_receiver/1]).
 
 -include("ejabberd.hrl").
+-include("jlib.hrl").
 
--record(socket_state, {sockmod, socket, receiver}).
+-type sockmod() :: ejabberd_http_poll | ejabberd_bosh |
+                   ejabberd_http_bind | ejabberd_http_bindjson |
+                   ejabberd_http_ws | ejabberd_http_wsjson |
+                   gen_tcp | tls | ejabberd_zlib.
+-type receiver() :: pid () | atom().
+-type socket() :: pid() | inet:socket() |
+                  tls:tls_socket() |
+                  ejabberd_zlib:zlib_socket() |
+                  ejabberd_bosh:bosh_socket() |
+                  ejabberd_http_ws:ws_socket() |
+                  ejabberd_http_poll:poll_socket().
+
+-record(socket_state, {sockmod = gen_tcp :: sockmod(),
+                       socket = self() :: socket(),
+                       receiver = self() :: receiver()}).
+
+-type socket_state() :: #socket_state{}.
+
+-export_type([socket_state/0, sockmod/0]).
+
+-spec start(atom(), sockmod(), socket(), [{atom(), any()}]) -> any().
+
+init() -> #socket_state{}.
 
-%%====================================================================
-%% API
-%%====================================================================
-%%--------------------------------------------------------------------
-%% Function:
-%% Description:
-%%--------------------------------------------------------------------
 start(Module, SockMod, Socket, Opts) ->
     case Module:socket_type() of
-	xml_stream ->
-	    MaxStanzaSize =
-		case lists:keysearch(max_stanza_size, 1, Opts) of
-		    {value, {_, Size}} -> Size;
-		    _ -> infinity
+      xml_stream ->
+	  MaxStanzaSize = case lists:keysearch(max_stanza_size, 1,
+					       Opts)
+			      of
+			    {value, {_, Size}} -> Size;
+			    _ -> infinity
+			  end,
+	  {ReceiverMod, Receiver, RecRef} = case catch
+						   SockMod:custom_receiver(Socket)
+						of
+					      {receiver, RecMod, RecPid} ->
+						  {RecMod, RecPid, RecMod};
+					      _ ->
+						  RecPid =
+						      ejabberd_receiver:start(Socket,
+									      SockMod,
+									      none,
+									      MaxStanzaSize),
+						  {ejabberd_receiver, RecPid,
+						   RecPid}
+					    end,
+	  SocketData = #socket_state{sockmod = SockMod,
+				     socket = Socket, receiver = RecRef},
+	  case Module:start({?MODULE, SocketData}, Opts) of
+	    {ok, Pid} ->
+		case SockMod:controlling_process(Socket, Receiver) of
+		  ok -> ok;
+		  {error, _Reason} -> SockMod:close(Socket)
 		end,
-	    {ReceiverMod, Receiver, RecRef} =
-		case catch SockMod:custom_receiver(Socket) of
-		    {receiver, RecMod, RecPid} ->
-			{RecMod, RecPid, RecMod};
-		    _ ->
-			RecPid = ejabberd_receiver:start(
-				   Socket, SockMod, none, MaxStanzaSize),
-			{ejabberd_receiver, RecPid, RecPid}
-		end,
-	    SocketData = #socket_state{sockmod = SockMod,
-				       socket = Socket,
-				       receiver = RecRef},
-	    case Module:start({?MODULE, SocketData}, Opts) of
-		{ok, Pid} ->
-		    case SockMod:controlling_process(Socket, Receiver) of
-			ok ->
-			    ok;
-			{error, _Reason} ->
-			    SockMod:close(Socket)
-		    end,
-		    ReceiverMod:become_controller(Receiver, Pid);
-		{error, _Reason} ->
-		    SockMod:close(Socket),
-		    case ReceiverMod of
-			ejabberd_receiver ->
-			    ReceiverMod:close(Receiver);
-			_ ->
-			    ok
-		    end
-	    end;
-	independent ->
-	    ok;
-	raw ->
-	    case Module:start({SockMod, Socket}, Opts) of
-		{ok, Pid} ->
-		    case SockMod:controlling_process(Socket, Pid) of
-			ok ->
-			    ok;
-			{error, _Reason} ->
-			    SockMod:close(Socket)
-		    end;
-		{error, _Reason} ->
-		    SockMod:close(Socket)
-	    end
+		ReceiverMod:become_controller(Receiver, Pid);
+	    {error, _Reason} ->
+		SockMod:close(Socket),
+		case ReceiverMod of
+		  ejabberd_receiver -> ReceiverMod:close(Receiver);
+		  _ -> ok
+		end
+	  end;
+      independent -> ok;
+      raw ->
+	  case Module:start({SockMod, Socket}, Opts) of
+	    {ok, Pid} ->
+		case SockMod:controlling_process(Socket, Pid) of
+		  ok -> ok;
+		  {error, _Reason} -> SockMod:close(Socket)
+		end;
+	    {error, _Reason} -> SockMod:close(Socket)
+	  end
     end.
 
 connect(Addr, Port, Opts) ->
@@ -116,89 +119,110 @@ connect(Addr, Port, Opts) ->
 
 connect(Addr, Port, Opts, Timeout) ->
     case gen_tcp:connect(Addr, Port, Opts, Timeout) of
-	{ok, Socket} ->
-	    Receiver = ejabberd_receiver:start(Socket, gen_tcp, none),
-	    SocketData = #socket_state{sockmod = gen_tcp,
-				       socket = Socket,
-				       receiver = Receiver},
-	    Pid = self(),
-	    case gen_tcp:controlling_process(Socket, Receiver) of
-		ok ->
-		    ejabberd_receiver:become_controller(Receiver, Pid),
-		    {ok, SocketData};
-		{error, _Reason} = Error ->
-		    gen_tcp:close(Socket),
-		    Error
-	    end;
-	{error, _Reason} = Error ->
-	    Error
+      {ok, Socket} ->
+	  Receiver = ejabberd_receiver:start(Socket, gen_tcp,
+					     none),
+	  SocketData = #socket_state{sockmod = gen_tcp,
+				     socket = Socket, receiver = Receiver},
+	  Pid = self(),
+	  case gen_tcp:controlling_process(Socket, Receiver) of
+	    ok ->
+		ejabberd_receiver:become_controller(Receiver, Pid),
+		{ok, SocketData};
+	    {error, _Reason} = Error -> gen_tcp:close(Socket), Error
+	  end;
+      {error, _Reason} = Error -> Error
     end.
 
 starttls(SocketData, TLSOpts) ->
-    {ok, TLSSocket} = tls:tcp_to_tls(SocketData#socket_state.socket, TLSOpts),
-    ejabberd_receiver:starttls(SocketData#socket_state.receiver, TLSSocket),
-    SocketData#socket_state{socket = TLSSocket, sockmod = tls}.
+    starttls(SocketData, TLSOpts, undefined).
 
 starttls(SocketData, TLSOpts, Data) ->
-    {ok, TLSSocket} = tls:tcp_to_tls(SocketData#socket_state.socket, TLSOpts),
-    ejabberd_receiver:starttls(SocketData#socket_state.receiver, TLSSocket),
-    send(SocketData, Data),
-    SocketData#socket_state{socket = TLSSocket, sockmod = tls}.
+    {ok, TLSSocket} =
+	ejabberd_receiver:starttls(SocketData#socket_state.receiver,
+				   TLSOpts, Data),
+    SocketData#socket_state{socket = TLSSocket,
+			    sockmod = tls}.
 
-compress(SocketData) ->
-    {ok, ZlibSocket} = ejabberd_zlib:enable_zlib(
-			 SocketData#socket_state.sockmod,
-			 SocketData#socket_state.socket),
-    ejabberd_receiver:compress(SocketData#socket_state.receiver, ZlibSocket),
-    SocketData#socket_state{socket = ZlibSocket, sockmod = ejabberd_zlib}.
+compress(SocketData) -> compress(SocketData, undefined).
 
 compress(SocketData, Data) ->
-    {ok, ZlibSocket} = ejabberd_zlib:enable_zlib(
-			 SocketData#socket_state.sockmod,
-			 SocketData#socket_state.socket),
-    ejabberd_receiver:compress(SocketData#socket_state.receiver, ZlibSocket),
-    send(SocketData, Data),
-    SocketData#socket_state{socket = ZlibSocket, sockmod = ejabberd_zlib}.
+    {ok, ZlibSocket} =
+	ejabberd_receiver:compress(SocketData#socket_state.receiver,
+				   Data),
+    SocketData#socket_state{socket = ZlibSocket,
+			    sockmod = ejabberd_zlib}.
 
-reset_stream(SocketData) when is_pid(SocketData#socket_state.receiver) ->
+reset_stream(SocketData)
+    when is_pid(SocketData#socket_state.receiver) ->
     ejabberd_receiver:reset_stream(SocketData#socket_state.receiver);
-reset_stream(SocketData) when is_atom(SocketData#socket_state.receiver) ->
-    (SocketData#socket_state.receiver):reset_stream(
-      SocketData#socket_state.socket).
+reset_stream(SocketData)
+    when is_atom(SocketData#socket_state.receiver) ->
+    (SocketData#socket_state.receiver):reset_stream(SocketData#socket_state.socket).
+
+change_controller(#socket_state{receiver = Recv}, Pid)
+    when is_pid(Recv) ->
+    ejabberd_receiver:setopts(Recv, [{active, false}]),
+    sync_events(Pid),
+    ejabberd_receiver:change_controller(Recv, Pid);
+change_controller(#socket_state{socket = Socket,
+				receiver = Mod},
+		  Pid) ->
+    Mod:setopts(Socket, [{active, false}]),
+    sync_events(Pid),
+    Mod:change_controller(Socket, Pid).
+
+change_socket(SocketData, Socket) ->
+    SocketData#socket_state{socket = Socket}.
+
+-spec send(socket_state(), iodata()) -> ok.
 
-%% sockmod=gen_tcp|tls|ejabberd_zlib
 send(SocketData, Data) ->
-    case catch (SocketData#socket_state.sockmod):send(
-	     SocketData#socket_state.socket, Data) of
-        ok -> ok;
-	{error, timeout} ->
-	    ?INFO_MSG("Timeout on ~p:send",[SocketData#socket_state.sockmod]),
-	    exit(normal);
-        Error ->
-	    ?DEBUG("Error in ~p:send: ~p",[SocketData#socket_state.sockmod, Error]),
-	    exit(normal)
+    Res = if node(SocketData#socket_state.receiver) ==
+	       node() ->
+		 catch
+		   (SocketData#socket_state.sockmod):send(SocketData#socket_state.socket,
+							  Data);
+	     true ->
+		 catch
+		   ejabberd_receiver:send(SocketData#socket_state.receiver,
+					  Data)
+	  end,
+    case Res of
+      ok -> ok;
+      {error, timeout} ->
+	  ?INFO_MSG("Timeout on ~p:send",
+		    [SocketData#socket_state.sockmod]),
+	  exit(normal);
+      Error ->
+	  ?DEBUG("Error in ~p:send: ~p",
+		 [SocketData#socket_state.sockmod, Error]),
+	  exit(normal)
     end.
 
-%% Can only be called when in c2s StateData#state.xml_socket is true
-%% This function is used for HTTP bind
-%% sockmod=ejabberd_http_poll|ejabberd_http_bind or any custom module
+-spec send_xml(socket_state(), xmlel()) -> any().
+
 send_xml(SocketData, Data) ->
-    catch (SocketData#socket_state.sockmod):send_xml(
-	    SocketData#socket_state.socket, Data).
+    catch
+      (SocketData#socket_state.sockmod):send_xml(SocketData#socket_state.socket,
+						 Data).
 
 change_shaper(SocketData, Shaper)
-  when is_pid(SocketData#socket_state.receiver) ->
-    ejabberd_receiver:change_shaper(SocketData#socket_state.receiver, Shaper);
+    when is_pid(SocketData#socket_state.receiver) ->
+    ejabberd_receiver:change_shaper(SocketData#socket_state.receiver,
+				    Shaper);
 change_shaper(SocketData, Shaper)
-  when is_atom(SocketData#socket_state.receiver) ->
-    (SocketData#socket_state.receiver):change_shaper(
-      SocketData#socket_state.socket, Shaper).
+    when is_atom(SocketData#socket_state.receiver) ->
+    (SocketData#socket_state.receiver):change_shaper(SocketData#socket_state.socket,
+						     Shaper).
 
-monitor(SocketData) when is_pid(SocketData#socket_state.receiver) ->
-    erlang:monitor(process, SocketData#socket_state.receiver);
-monitor(SocketData) when is_atom(SocketData#socket_state.receiver) ->
-    (SocketData#socket_state.receiver):monitor(
-      SocketData#socket_state.socket).
+monitor(SocketData)
+    when is_pid(SocketData#socket_state.receiver) ->
+    erlang:monitor(process,
+		   SocketData#socket_state.receiver);
+monitor(SocketData)
+    when is_atom(SocketData#socket_state.receiver) ->
+    (SocketData#socket_state.receiver):monitor(SocketData#socket_state.socket).
 
 get_sockmod(SocketData) ->
     SocketData#socket_state.sockmod.
@@ -212,22 +236,53 @@ get_verify_result(SocketData) ->
 close(SocketData) ->
     ejabberd_receiver:close(SocketData#socket_state.receiver).
 
-sockname(#socket_state{sockmod = SockMod, socket = Socket}) ->
+sockname(#socket_state{sockmod = SockMod,
+		       socket = Socket}) ->
     case SockMod of
-	gen_tcp ->
-	    inet:sockname(Socket);
-	_ ->
-	    SockMod:sockname(Socket)
+      gen_tcp -> inet:sockname(Socket);
+      _ -> SockMod:sockname(Socket)
     end.
 
-peername(#socket_state{sockmod = SockMod, socket = Socket}) ->
+peername(#socket_state{sockmod = SockMod,
+		       socket = Socket}) ->
     case SockMod of
-	gen_tcp ->
-	    inet:peername(Socket);
-	_ ->
-	    SockMod:peername(Socket)
+      gen_tcp -> inet:peername(Socket);
+      _ -> SockMod:peername(Socket)
     end.
 
-%%====================================================================
-%% Internal functions
-%%====================================================================
+get_conn_type(#socket_state{sockmod = SockMod, socket = Socket}) ->
+    case SockMod of
+        gen_tcp -> c2s;
+        tls -> c2s_tls;
+        ejabberd_zlib ->
+            case ejabberd_zlib:get_sockmod(Socket) of
+                gen_tcp -> c2s_compressed;
+                tls -> c2s_compressed_tls
+            end;
+        ejabberd_http_poll -> http_poll;
+        ejabberd_http_ws -> http_ws;
+        ejabberd_http_bind -> http_bind;
+        ejabberd_bosh -> http_bind;
+        ejabberd_http_bindjson -> http_bindjson;
+        ejabberd_http_wsjson -> http_wsjson
+    end.
+
+-spec is_remote_receiver(socket_state()) -> boolean().
+
+is_remote_receiver(#socket_state{receiver = Pid}) when is_pid(Pid) ->
+    node(Pid) /= node();
+is_remote_receiver(_) ->
+    false.
+
+sync_events(C2SPid) ->
+    receive
+      {'$gen_event', El} = Event
+	  when element(1, El) == xmlel;
+	       element(1, El) == xmlstreamstart;
+	       element(1, El) == xmlstreamelement;
+	       element(1, El) == xmlstreamend;
+	       element(1, El) == xmlstreamerror ->
+	  C2SPid ! Event, sync_events(C2SPid);
+      closed -> C2SPid ! closed, sync_events(C2SPid)
+      after 0 -> ok
+    end.

src/ejabberd_sup.erl

@@ -5,7 +5,7 @@
 %%% Created : 31 Jan 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -42,13 +42,6 @@ init([]) ->
 	 brutal_kill,
 	 worker,
 	 [ejabberd_hooks]},
-    NodeGroups =
-	{ejabberd_node_groups,
-	 {ejabberd_node_groups, start_link, []},
-	 permanent,
-	 brutal_kill,
-	 worker,
-	 [ejabberd_node_groups]},
     SystemMonitor =
 	{ejabberd_system_monitor,
 	 {ejabberd_system_monitor, start_link, []},
@@ -63,6 +56,13 @@ init([]) ->
 	 brutal_kill,
 	 worker,
 	 [ejabberd_router]},
+    Router_multicast =
+	{ejabberd_router_multicast,
+	 {ejabberd_router_multicast, start_link, []},
+	 permanent,
+	 brutal_kill,
+	 worker,
+	 [ejabberd_router_multicast]},
     SM =
 	{ejabberd_sm,
 	 {ejabberd_sm, start_link, []},
@@ -163,12 +163,18 @@ init([]) ->
 	 [ejabberd_tmp_sup]},
     IQSupervisor =
 	{ejabberd_iq_sup,
-	 {ejabberd_tmp_sup, start_link,
-	  [ejabberd_iq_sup, gen_iq_handler]},
+	 {ejabberd_iq_sup, start_link, []},
 	 permanent,
 	 infinity,
 	 supervisor,
-	 [ejabberd_tmp_sup]},
+	 [ejabberd_iq_sup]},
+    SMHandlerSup =
+        {ejabberd_sm_sup,
+	 {ejabberd_sm_sup, start_link, []},
+	 permanent,
+	 infinity,
+	 supervisor,
+	 [ejabberd_sm_sup]},
     STUNSupervisor =
 	{ejabberd_stun_sup,
 	 {ejabberd_tmp_sup, start_link,
@@ -186,9 +192,10 @@ init([]) ->
 	 [cache_tab_sup]},
     {ok, {{one_for_one, 10, 1},
 	  [Hooks,
-	   NodeGroups,
 	   SystemMonitor,
 	   Router,
+	   Router_multicast,
+           SMHandlerSup,
 	   SM,
 	   S2S,
 	   Local,

src/ejabberd_system_monitor.erl

@@ -5,7 +5,7 @@
 %%% Created : 21 Mar 2007 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,343 +25,264 @@
 %%%-------------------------------------------------------------------
 
 -module(ejabberd_system_monitor).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
 
 %% API
--export([start_link/0,
-	 process_command/3,
+-export([start_link/0, process_command/3,
 	 process_remote_command/1]).
 
 %% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
-	 terminate/2, code_change/3]).
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, terminate/2, code_change/3]).
 
 -include("ejabberd.hrl").
+
 -include("jlib.hrl").
 
 -record(state, {}).
 
-%%====================================================================
-%% API
-%%====================================================================
-%%--------------------------------------------------------------------
-%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
-%% Description: Starts the server
-%%--------------------------------------------------------------------
 start_link() ->
-    LH = case ejabberd_config:get_local_option(watchdog_large_heap) of
-	I when is_integer(I) -> I;
-	_ -> 1000000
-end,
+    LH = ejabberd_config:get_local_option(
+           watchdog_large_heap,
+           fun(I) when is_integer(I), I > 0 -> I end,
+	   1000000),
     Opts = [{large_heap, LH}],
-    gen_server:start_link({local, ?MODULE}, ?MODULE, Opts, []).
+    gen_server:start_link({local, ?MODULE}, ?MODULE, Opts,
+			  []).
 
 process_command(From, To, Packet) ->
     case To of
-	#jid{luser = "", lresource = "watchdog"} ->
-	    {xmlelement, Name, _Attrs, _Els} = Packet,
-	    case Name of
-		"message" ->
-		    LFrom = jlib:jid_tolower(jlib:jid_remove_resource(From)),
-		    case lists:member(LFrom, get_admin_jids()) of
-			true ->
-			    Body = xml:get_path_s(
-				     Packet, [{elem, "body"}, cdata]),
-			    spawn(fun() ->
-					  process_flag(priority, high),
-					  process_command1(From, To, Body)
-				  end),
-			    stop;
-			false ->
-			    ok
-		    end;
-		_ ->
-		    ok
-	    end;
-	_ ->
-	    ok
+      #jid{luser = <<"">>, lresource = <<"watchdog">>} ->
+	  #xmlel{name = Name} = Packet,
+	  case Name of
+	    <<"message">> ->
+		LFrom =
+		    jlib:jid_tolower(jlib:jid_remove_resource(From)),
+		case lists:member(LFrom, get_admin_jids()) of
+		  true ->
+		      Body = xml:get_path_s(Packet,
+					    [{elem, <<"body">>}, cdata]),
+		      spawn(fun () ->
+				    process_flag(priority, high),
+				    process_command1(From, To, Body)
+			    end),
+		      stop;
+		  false -> ok
+		end;
+	    _ -> ok
+	  end;
+      _ -> ok
     end.
 
 %%====================================================================
 %% gen_server callbacks
 %%====================================================================
 
-%%--------------------------------------------------------------------
-%% Function: init(Args) -> {ok, State} |
-%%                         {ok, State, Timeout} |
-%%                         ignore               |
-%%                         {stop, Reason}
-%% Description: Initiates the server
-%%--------------------------------------------------------------------
 init(Opts) ->
     LH = proplists:get_value(large_heap, Opts),
     process_flag(priority, high),
     erlang:system_monitor(self(), [{large_heap, LH}]),
-    lists:foreach(
-      fun(Host) ->
-	      ejabberd_hooks:add(local_send_to_resource_hook, Host,
-				 ?MODULE, process_command, 50)
-      end, ?MYHOSTS),
+    lists:foreach(fun (Host) ->
+			  ejabberd_hooks:add(local_send_to_resource_hook, Host,
+					     ?MODULE, process_command, 50)
+		  end,
+		  ?MYHOSTS),
     {ok, #state{}}.
 
-%%--------------------------------------------------------------------
-%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
-%%                                      {reply, Reply, State, Timeout} |
-%%                                      {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, Reply, State} |
-%%                                      {stop, Reason, State}
-%% Description: Handling call messages
-%%--------------------------------------------------------------------
 handle_call({get, large_heap}, _From, State) ->
     {reply, get_large_heap(), State};
-handle_call({set, large_heap, NewValue}, _From, State) ->
-    MonSettings = erlang:system_monitor(self(), [{large_heap, NewValue}]),
+handle_call({set, large_heap, NewValue}, _From,
+	    State) ->
+    MonSettings = erlang:system_monitor(self(),
+					[{large_heap, NewValue}]),
     OldLH = get_large_heap(MonSettings),
     NewLH = get_large_heap(),
     {reply, {lh_changed, OldLH, NewLH}, State};
 handle_call(_Request, _From, State) ->
-    Reply = ok,
-    {reply, Reply, State}.
+    Reply = ok, {reply, Reply, State}.
 
 get_large_heap() ->
     MonSettings = erlang:system_monitor(),
     get_large_heap(MonSettings).
+
 get_large_heap(MonSettings) ->
     {_MonitorPid, Options} = MonSettings,
     proplists:get_value(large_heap, Options).
 
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, State}
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
-handle_cast(_Msg, State) ->
-    {noreply, State}.
+handle_cast(_Msg, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%%                                       {noreply, State, Timeout} |
-%%                                       {stop, Reason, State}
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
 handle_info({monitor, Pid, large_heap, Info}, State) ->
-    spawn(fun() ->
+    spawn(fun () ->
 		  process_flag(priority, high),
 		  process_large_heap(Pid, Info)
 	  end),
     {noreply, State};
-handle_info(_Info, State) ->
-    {noreply, State}.
+handle_info(_Info, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> void()
-%% Description: This function is called by a gen_server when it is about to
-%% terminate. It should be the opposite of Module:init/1 and do any necessary
-%% cleaning up. When it returns, the gen_server terminates with Reason.
-%% The return value is ignored.
-%%--------------------------------------------------------------------
-terminate(_Reason, _State) ->
-    ok.
+terminate(_Reason, _State) -> ok.
 
-%%--------------------------------------------------------------------
-%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
-    {ok, State}.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
 
 %%--------------------------------------------------------------------
 %%% Internal functions
 %%--------------------------------------------------------------------
 
 process_large_heap(Pid, Info) ->
-    Host = ?MYNAME,
-    case ejabberd_config:get_local_option(watchdog_admins) of
-	JIDs when is_list(JIDs),
-		  JIDs /= [] ->
-	    DetailedInfo = detailed_info(Pid),
-	    Body = io_lib:format(
-		     "(~w) The process ~w is consuming too much memory:~n~p~n"
-		     "~s",
-		     [node(), Pid, Info, DetailedInfo]),
-	    From = jlib:make_jid("", Host, "watchdog"),
-	    lists:foreach(
-	      fun(S) ->
-		      case jlib:string_to_jid(S) of
-			  error -> ok;
-			  JID ->
-			      send_message(From, JID, Body)
-		      end
-	      end, JIDs);
-	_ ->
-	    ok
-    end.
+    Host = (?MYNAME),
+    JIDs = get_admin_jids(),
+    DetailedInfo = detailed_info(Pid),
+    Body = iolist_to_binary(
+             io_lib:format("(~w) The process ~w is consuming too "
+                           "much memory:~n~p~n~s",
+                           [node(), Pid, Info, DetailedInfo])),
+    From = jlib:make_jid(<<"">>, Host, <<"watchdog">>),
+    lists:foreach(fun (JID) ->
+                          send_message(From, jlib:make_jid(JID), Body)
+                  end, JIDs).
 
 send_message(From, To, Body) ->
-    ejabberd_router:route(
-      From, To,
-      {xmlelement, "message", [{"type", "chat"}],
-       [{xmlelement, "body", [],
-	 [{xmlcdata, lists:flatten(Body)}]}]}).
+    ejabberd_router:route(From, To,
+			  #xmlel{name = <<"message">>,
+				 attrs = [{<<"type">>, <<"chat">>}],
+				 children =
+				     [#xmlel{name = <<"body">>, attrs = [],
+					     children =
+						 [{xmlcdata, Body}]}]}).
 
 get_admin_jids() ->
-    case ejabberd_config:get_local_option(watchdog_admins) of
-	JIDs when is_list(JIDs) ->
-	    lists:flatmap(
-	      fun(S) ->
-		      case jlib:string_to_jid(S) of
-			  error -> [];
-			  JID -> [jlib:jid_tolower(JID)]
-		      end
-	      end, JIDs);
-	_ ->
-	    []
-    end.
+    ejabberd_config:get_local_option(
+      watchdog_admins,
+      fun(JIDs) ->
+              [jlib:jid_tolower(
+                 jlib:string_to_jid(
+                   iolist_to_binary(S))) || S <- JIDs]
+      end, []).
 
 detailed_info(Pid) ->
     case process_info(Pid, dictionary) of
-	{dictionary, Dict} ->
-	    case lists:keysearch('$ancestors', 1, Dict) of
-		{value, {'$ancestors', [Sup | _]}} ->
-		    case Sup of
-			ejabberd_c2s_sup ->
-			    c2s_info(Pid);
-			ejabberd_s2s_out_sup ->
-			    s2s_out_info(Pid);
-			ejabberd_service_sup ->
-			    service_info(Pid);
-			_ ->
-			    detailed_info1(Pid)
-		    end;
-		_ ->
-		    detailed_info1(Pid)
-	    end;
-	_ ->
-	    detailed_info1(Pid)
+      {dictionary, Dict} ->
+	  case lists:keysearch('$ancestors', 1, Dict) of
+	    {value, {'$ancestors', [Sup | _]}} ->
+		case Sup of
+		  ejabberd_c2s_sup -> c2s_info(Pid);
+		  ejabberd_s2s_out_sup -> s2s_out_info(Pid);
+		  ejabberd_service_sup -> service_info(Pid);
+		  _ -> detailed_info1(Pid)
+		end;
+	    _ -> detailed_info1(Pid)
+	  end;
+      _ -> detailed_info1(Pid)
     end.
 
 detailed_info1(Pid) ->
-    io_lib:format(
-      "~p", [[process_info(Pid, current_function),
-	      process_info(Pid, initial_call),
-	      process_info(Pid, message_queue_len),
-	      process_info(Pid, links),
-	      process_info(Pid, dictionary),
-	      process_info(Pid, heap_size),
-	      process_info(Pid, stack_size)
-	     ]]).
+    io_lib:format("~p",
+		  [[process_info(Pid, current_function),
+		    process_info(Pid, initial_call),
+		    process_info(Pid, message_queue_len),
+		    process_info(Pid, links), process_info(Pid, dictionary),
+		    process_info(Pid, heap_size),
+		    process_info(Pid, stack_size)]]).
 
 c2s_info(Pid) ->
-    ["Process type: c2s",
-     check_send_queue(Pid),
-     "\n",
+    [<<"Process type: c2s">>, check_send_queue(Pid),
+     <<"\n">>,
      io_lib:format("Command to kill this process: kill ~s ~w",
-		   [atom_to_list(node()), Pid])].
+		   [iolist_to_binary(atom_to_list(node())), Pid])].
 
 s2s_out_info(Pid) ->
-    FromTo = mnesia:dirty_select(
-	       s2s, [{{s2s, '$1', Pid, '_'}, [], ['$1']}]),
-    ["Process type: s2s_out",
+    FromTo = mnesia:dirty_select(s2s,
+				 [{{s2s, '$1', Pid, '_'}, [], ['$1']}]),
+    [<<"Process type: s2s_out">>,
      case FromTo of
-	 [{From, To}] ->
-	     "\n" ++ io_lib:format("S2S connection: from ~s to ~s",
-				   [From, To]);
-	 _ ->
-	     ""
+       [{From, To}] ->
+	   <<"\n",
+	     (io_lib:format("S2S connection: from ~s to ~s",
+			    [From, To]))/binary>>;
+       _ -> <<"">>
      end,
-     check_send_queue(Pid),
-     "\n",
+     check_send_queue(Pid), <<"\n">>,
      io_lib:format("Command to kill this process: kill ~s ~w",
-		   [atom_to_list(node()), Pid])].
+		   [iolist_to_binary(atom_to_list(node())), Pid])].
 
 service_info(Pid) ->
-    Routes = mnesia:dirty_select(
-	       route, [{{route, '$1', Pid, '_'}, [], ['$1']}]),
-    ["Process type: s2s_out",
+    Routes = mnesia:dirty_select(route,
+				 [{{route, '$1', Pid, '_'}, [], ['$1']}]),
+    [<<"Process type: s2s_out">>,
      case Routes of
-	 [Route] ->
-	     "\nServiced domain: " ++ Route;
-	 _ ->
-	     ""
+       [Route] -> <<"\nServiced domain: ", Route/binary>>;
+       _ -> <<"">>
      end,
-     check_send_queue(Pid),
-     "\n",
+     check_send_queue(Pid), <<"\n">>,
      io_lib:format("Command to kill this process: kill ~s ~w",
-		   [atom_to_list(node()), Pid])].
+		   [iolist_to_binary(atom_to_list(node())), Pid])].
 
 check_send_queue(Pid) ->
     case {process_info(Pid, current_function),
-	  process_info(Pid, message_queue_len)} of
-	{{current_function, MFA}, {message_queue_len, MLen}} ->
-	    if
-		MLen > 100 ->
-		    case MFA of
-			{prim_inet, send, 2} ->
-			    "\nPossible reason: the process is blocked "
-				"trying to send data over its TCP connection.";
-			{M, F, A} ->
-			    ["\nPossible reason: the process can't process "
-			     "messages faster than they arrive.  ",
-			     io_lib:format("Current function is ~w:~w/~w",
-					   [M, F, A])
-			    ]
-		    end;
-		true ->
-		    ""
-	    end;
-	_ ->
-	    ""
+	  process_info(Pid, message_queue_len)}
+	of
+      {{current_function, MFA}, {message_queue_len, MLen}} ->
+	  if MLen > 100 ->
+		 case MFA of
+		   {prim_inet, send, 2} ->
+		       <<"\nPossible reason: the process is blocked "
+			 "trying to send data over its TCP connection.">>;
+		   {M, F, A} ->
+		       [<<"\nPossible reason: the process can't "
+			  "process messages faster than they arrive.  ">>,
+			io_lib:format("Current function is ~w:~w/~w",
+				      [M, F, A])]
+		 end;
+	     true -> <<"">>
+	  end;
+      _ -> <<"">>
     end.
 
 process_command1(From, To, Body) ->
-    process_command2(string:tokens(Body, " "), From, To).
+    process_command2(str:tokens(Body, <<" ">>), From, To).
 
-process_command2(["kill", SNode, SPid], From, To) ->
-    Node = list_to_atom(SNode),
+process_command2([<<"kill">>, SNode, SPid], From, To) ->
+    Node = jlib:binary_to_atom(SNode),
     remote_command(Node, [kill, SPid], From, To);
-process_command2(["showlh", SNode], From, To) ->
-    Node = list_to_atom(SNode),
+process_command2([<<"showlh">>, SNode], From, To) ->
+    Node = jlib:binary_to_atom(SNode),
     remote_command(Node, [showlh], From, To);
-process_command2(["setlh", SNode, NewValueString], From, To) ->
-    Node = list_to_atom(SNode),
-    NewValue = list_to_integer(NewValueString),
+process_command2([<<"setlh">>, SNode, NewValueString],
+		 From, To) ->
+    Node = jlib:binary_to_atom(SNode),
+    NewValue = jlib:binary_to_integer(NewValueString),
     remote_command(Node, [setlh, NewValue], From, To);
-process_command2(["help"], From, To) ->
+process_command2([<<"help">>], From, To) ->
     send_message(To, From, help());
 process_command2(_, From, To) ->
     send_message(To, From, help()).
 
-
 help() ->
-    "Commands:\n"
-	"  kill <node> <pid>\n"
-	"  showlh <node>\n"
-	"  setlh <node> <integer>".
-
+    <<"Commands:\n  kill <node> <pid>\n  showlh "
+      "<node>\n  setlh <node> <integer>">>.
 
 remote_command(Node, Args, From, To) ->
-    Message =
-	case rpc:call(Node, ?MODULE, process_remote_command, [Args]) of
-	    {badrpc, Reason} ->
-		io_lib:format("Command failed:~n~p", [Reason]);
-	    Result ->
-		Result
-	end,
-    send_message(To, From, Message).
+    Message = case rpc:call(Node, ?MODULE,
+			    process_remote_command, [Args])
+		  of
+		{badrpc, Reason} ->
+		    io_lib:format("Command failed:~n~p", [Reason]);
+		Result -> Result
+	      end,
+    send_message(To, From, iolist_to_binary(Message)).
 
 process_remote_command([kill, SPid]) ->
-    exit(list_to_pid(SPid), kill),
-    "ok";
+    exit(list_to_pid(SPid), kill), <<"ok">>;
 process_remote_command([showlh]) ->
-    Res = gen_server:call(ejabberd_system_monitor, {get, large_heap}),
+    Res = gen_server:call(ejabberd_system_monitor,
+			  {get, large_heap}),
     io_lib:format("Current large heap: ~p", [Res]);
 process_remote_command([setlh, NewValue]) ->
-    {lh_changed, OldLH, NewLH} = gen_server:call(ejabberd_system_monitor, {set, large_heap, NewValue}),
-    io_lib:format("Result of set large heap: ~p --> ~p", [OldLH, NewLH]);
-process_remote_command(_) ->
-    throw(unknown_command).
-
+    {lh_changed, OldLH, NewLH} =
+	gen_server:call(ejabberd_system_monitor,
+			{set, large_heap, NewValue}),
+    io_lib:format("Result of set large heap: ~p --> ~p",
+		  [OldLH, NewLH]);
+process_remote_command(_) -> throw(unknown_command).

src/ejabberd_tmp_sup.erl

@@ -5,7 +5,7 @@
 %%% Created : 18 Jul 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,6 +25,7 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_tmp_sup).
+
 -author('alexey@process-one.net').
 
 -export([start_link/2, init/1]).
@@ -32,8 +33,8 @@
 start_link(Name, Module) ->
     supervisor:start_link({local, Name}, ?MODULE, Module).
 
-
 init(Module) ->
-    {ok, {{simple_one_for_one, 10, 1},
-	  [{undefined, {Module, start_link, []},
-	    temporary, brutal_kill, worker, [Module]}]}}.
+    {ok,
+     {{simple_one_for_one, 10, 1},
+      [{undefined, {Module, start_link, []}, temporary,
+	brutal_kill, worker, [Module]}]}}.

src/ejabberd_update.erl

@@ -5,7 +5,7 @@
 %%% Created : 27 Jan 2006 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -67,16 +67,8 @@ update(ModulesToUpdate) ->
 	    {error, Reason}
     end.
 
-%% OTP R14B03 and older provided release_handler_1:eval_script/3
-%% But OTP R14B04 and newer provide release_handler_1:eval_script/5
-%% Dialyzer reports a call to missing function; don't worry.
 eval_script(Script, Apps, LibDirs) ->
-    case lists:member({eval_script, 5}, release_handler_1:module_info(exports)) of
-	true ->
-	    release_handler_1:eval_script(Script, Apps, LibDirs, [], []);
-	false ->
-	    release_handler_1:eval_script(Script, Apps, LibDirs)
-    end.
+    release_handler_1:eval_script(Script, Apps, LibDirs, [], []).
 
 %% Get information about the modified modules
 update_info() ->
@@ -142,23 +134,19 @@ build_script(Dir, UpdatedBeams) ->
 	release_handler_1:check_script(
 	  LowLevelScript,
 	  [{ejabberd, "", filename:join(Dir, "..")}]),
-    case Check of
-	ok -> 
-	    %% This clause is for OTP R14B03 and older.
-	    %% Newer Dialyzer reports a never match pattern; don't worry.
-	    ?DEBUG("script: ~p~n", [Script]),
-	    ?DEBUG("low level script: ~p~n", [LowLevelScript]),
-	    ?DEBUG("check: ~p~n", [Check]);
+    Check2 = case Check of
 	{ok, []} ->
 	    ?DEBUG("script: ~p~n", [Script]),
 	    ?DEBUG("low level script: ~p~n", [LowLevelScript]),
-	    ?DEBUG("check: ~p~n", [Check]);
+	    ?DEBUG("check: ~p~n", [Check]),
+	    "ok";
 	_ ->
 	    ?ERROR_MSG("script: ~p~n", [Script]),
 	    ?ERROR_MSG("low level script: ~p~n", [LowLevelScript]),
-	    ?ERROR_MSG("check: ~p~n", [Check])
+	    ?ERROR_MSG("check: ~p~n", [Check]),
+	    io_lib:format("~p", [Check])
     end,
-    {Script, LowLevelScript, Check}.
+    {Script, LowLevelScript, Check2}.
 
 %% Copied from Erlang/OTP file: lib/sasl/src/systools.hrl
 -record(application, 

src/ejabberd_xmlrpc.erl

@@ -0,0 +1,448 @@
+%%%----------------------------------------------------------------------
+%%% File    : ejabberd_xmlrpc.erl
+%%% Author  : Badlop <badlop@process-one.net>
+%%% Purpose : XML-RPC server that frontends ejabberd commands
+%%% Created : 21 Aug 2007 by Badlop <badlop@ono.com>
+%%% Id      : $Id: ejabberd_xmlrpc.erl 595 2008-05-20 11:39:31Z badlop $
+%%%----------------------------------------------------------------------
+
+%%% TODO: Implement a command in ejabberdctl 'help COMMAND LANGUAGE' that shows
+%%% a coding example to call that command in a specific language (python, php).
+
+%%% TODO: Remove support for plaintext password
+
+%%% TODO: commands strings should be strings without ~n
+
+-module(ejabberd_xmlrpc).
+
+-author('badlop@process-one.net').
+
+-export([start/2, handler/2, socket_type/0]).
+
+-include("ejabberd.hrl").
+
+-include("mod_roster.hrl").
+
+-include("jlib.hrl").
+
+-record(state,
+	{access_commands = [] :: list(),
+         auth = noauth        :: noauth | {binary(), binary(), binary()},
+         get_auth = true      :: boolean()}).
+
+%% Test:
+
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, take_integer, [{struct, [{thisinteger, 5}]}]}).
+%% {ok,{response,[{struct,[{zero,0}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echo_string, [{struct, [{thisstring, "abcd"}]}]}).
+%% {ok,{response,[{struct,[{thatstring,"abcd"}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, tell_tuple_3integer, [{struct, [{thisstring, "abcd"}]}]}).
+%% {ok,{response,
+%%         [{struct,
+%%              [{thattuple,
+%%                   {array,
+%%                       [{struct,[{first,123}]},
+%%                        {struct,[{second,456}]},
+%%                        {struct,[{third,789}]}]}}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, pow, [{struct, [{base, 5}, {exponent, 7}]}]}).
+%% {ok,{response,[{struct,[{pow,78125}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, seq, [{struct, [{from, 3}, {to, 7}]}]}).
+%% {ok,{response,[{array,[{struct,[{intermediate,3}]},
+%%                        {struct,[{intermediate,4}]},
+%%                        {struct,[{intermediate,5}]},
+%%                        {struct,[{intermediate,6}]},
+%%                        {struct,[{intermediate,7}]}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, substrs, [{struct, [{word, "abcd"}]}]}).
+%% NO:
+%% {ok,{response,[{array,[{struct,[{miniword,"a"}]},
+%%                        {struct,[{miniword,"ab"}]},
+%%                        {struct,[{miniword,"abc"}]},
+%%                        {struct,[{miniword,"abcd"}]}]}]}}
+%% {ok,{response,
+%%         [{struct,
+%%              [{substrings,
+%%                   {array,
+%%                       [{struct,[{miniword,"a"}]},
+%%                        {struct,[{miniword,"ab"}]},
+%%                        {struct,[{miniword,"abc"}]},
+%%                        {struct,[{miniword,"abcd"}]}]}}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, splitjid, [{struct, [{jid, "abcd@localhost/work"}]}]}).
+%% {ok,{response,
+%%         [{struct,
+%%              [{jidparts,
+%%                   {array,
+%%                       [{struct,[{user,"abcd"}]},
+%%                        {struct,[{server,"localhost"}]},
+%%                        {struct,[{resource,"work"}]}]}}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echo_integer_string, [{struct, [{thisstring, "abc"}, {thisinteger, 55}]}]}).
+%% {ok,{response,
+%%         [{struct,
+%%              [{thistuple,
+%%                   {array,
+%%                       [{struct,[{thisinteger,55}]},
+%%                        {struct,[{thisstring,"abc"}]}]}}]}]}}
+%%
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echo_list_integer, [{struct, [{thislist, {array, [{struct, [{thisinteger, 55}, {thisinteger, 4567}]}]}}]}]}).
+%% {ok,{response,
+%%         [{struct,
+%%              [{thatlist,
+%%                   {array,
+%%                       [{struct,[{thatinteger,55}]},
+%%                        {struct,[{thatinteger,4567}]}]}}]}]}}
+%%
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echo_integer_list_string, [{struct, [{thisinteger, 123456}, {thislist, {array, [{struct, [{thisstring, "abc"}, {thisstring, "bobo baba"}]}]}}]}]}).
+%% {ok,
+%%  {response,
+%%   [{struct,
+%%     [{thistuple,
+%%       {array,
+%%        [{struct,[{thatinteger,123456}]},
+%%         {struct,
+%%          [{thatlist,
+%%            {array,
+%%             [{struct,[{thatstring,"abc"}]},
+%%              {struct,[{thatstring,"bobo baba"}]}]}}]}]}}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, take_tuple_2integer, [{struct, [{thistuple, {array, [{struct, [{thisinteger1, 55}, {thisinteger2, 4567}]}]}}]}]}).
+%% {ok,{response,[{struct,[{zero,0}]}]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echo_isatils, [{struct,
+%% 	                                      [{thisinteger, 123456990},
+%% 			                               {thisstring, "This is ISATILS"},
+%% 			                               {thisatom, "test_isatils"},
+%% 			                               {thistuple, {array, [{struct, [
+%%                                            {listlen, 2},
+%% 			                                  {thislist, {array, [{struct, [
+%%                                               {contentstring, "word1"},
+%%                                               {contentstring, "word 2"}
+%%                                            ]}]}}
+%% 										   ]}]}}
+%% 										  ]}]}).
+%% {ok,{response,
+%%         [{struct,
+%%              [{results,
+%%                   {array,
+%%                       [{struct,[{thatinteger,123456990}]},
+%%                        {struct,[{thatstring,"This is ISATILS"}]},
+%%                        {struct,[{thatatom,"test_isatils"}]},
+%%                        {struct,
+%%                            [{thattuple,
+%%                                 {array,
+%%                                     [{struct,[{listlen,123456990}]},
+%%                                      {struct,[{thatlist,...}]}]}}]}]}}]}]}}
+
+%% ecommand doesn't exist:
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echo_integer_string2, [{struct, [{thisstring, "abc"}]}]}).
+%% {ok,{response,{fault,-1, "Unknown call: {call,echo_integer_string2,[{struct,[{thisstring,\"abc\"}]}]}"}}}
+%%
+%% Duplicated argument:
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echo_integer_string, [{struct, [{thisstring, "abc"}, {thisinteger, 44}, {thisinteger, 55}]}]}).
+%% {ok,{response,{fault,-104, "Error -104\nAttribute 'thisinteger' duplicated:\n[{thisstring,\"abc\"},{thisinteger,44},{thisinteger,55}]"}}}
+%%
+%% Missing argument:
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echo_integer_string, [{struct, [{thisstring, "abc"}]}]}).
+%% {ok,{response,{fault,-106, "Error -106\nRequired attribute 'thisinteger' not found:\n[{thisstring,\"abc\"}]"}}}
+%%
+%% Duplicated tuple element:
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, take_tuple_2integer, [{struct, [{thistuple, {array, [{struct, [{thisinteger1, 55}, {thisinteger1, 66}, {thisinteger2, 4567}]}]}}]}]}).
+%% {ok,{response,{fault,-104, "Error -104\nAttribute 'thisinteger1' defined multiple times:\n[{thisinteger1,55},{thisinteger1,66},{thisinteger2,4567}]"}}}
+%%
+%% Missing element in tuple:
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, take_tuple_2integer, [{struct, [{thistuple, {array, [{struct, [{thisinteger1, 55}, {thisintegerc, 66}, {thisinteger, 4567}]}]}}]}]}).
+%% {ok,{response,{fault,-106, "Error -106\nRequired attribute 'thisinteger2' not found:\n[{thisintegerc,66},{thisinteger,4567}]"}}}
+%%
+%% The ecommand crashed:
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, this_crashes, [{struct, []}]}).
+%% {ok,{response,{fault,-100, "Error -100\nA problem 'error' occurred executing the command this_crashes with arguments []: badarith"}}}
+
+%% -----------------------------
+%% Listener interface
+%% -----------------------------
+
+start({gen_tcp = _SockMod, Socket}, Opts) ->
+    %MaxSessions = gen_mod:get_opt(maxsessions, Opts,
+    %                              fun(I) when is_integer(I), I>0 -> I end,
+    %                              10),
+    Timeout = gen_mod:get_opt(timeout, Opts,
+                              fun(I) when is_integer(I), I>0 -> I end,
+                              5000),
+    AccessCommands = gen_mod:get_opt(access_commands, Opts,
+                                     fun(V) -> V end,
+				     []),
+    GetAuth = case [ACom
+		    || {Ac, _, _} = ACom <- AccessCommands, Ac /= all]
+		  of
+		[] -> false;
+		_ -> true
+	      end,
+    Handler = {?MODULE, handler},
+    State = #state{access_commands = AccessCommands,
+		   get_auth = GetAuth},
+    Pid = proc_lib:spawn(xmlrpc_http, handler, [Socket, Timeout, Handler, State]),
+    {ok, Pid}.
+
+socket_type() -> raw.
+
+%% -----------------------------
+%% Access verification
+%% -----------------------------
+
+get_auth(AuthList) ->
+    [User, Server, Password] = try get_attrs([user, server,
+					      password],
+					     AuthList)
+			       of
+				 [U, S, P] -> [U, S, P]
+			       catch
+				 exit:{attribute_not_found, Attr, _} ->
+				     throw({error, missing_auth_arguments,
+					    Attr})
+			       end,
+    {User, Server, Password}.
+
+%% -----------------------------
+%% Handlers
+%% -----------------------------
+
+%% Call:           Arguments:                                      Returns:
+
+%% .............................
+%%  Access verification
+
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echothis, [152]}).
+%% {ok,{response,{fault,-103, "Error -103\nRequired authentication: {call,echothis,[152]}"}}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echothis, [{struct, [{user, "badlop"}, {server, "localhost"}, {password, "ada"}]}, 152]}).
+%% {ok,{response,{fault,-103,
+%%      "Error -103\nAuthentication non valid: [{user,\"badlop\"},\n
+%% 	 {server,\"localhost\"},\n
+%% 	 {password,\"ada\"}]"}}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echothis, [{struct, [{user, "badlop"}, {server, "localhost"}, {password, "ada90ada"}]}, 152]}).
+%% {ok,{response,[152]}}
+%%
+%% xmlrpc:call({127, 0, 0, 1}, 4560, "/", {call, echothis, [{struct, [{user, "badlop"}, {server, "localhost"}, {password, "79C1574A43BC995F2B145A299EF97277"}]}, 152]}).
+%% {ok,{response,[152]}}
+
+handler(#state{get_auth = true, auth = noauth} = State,
+	{call, Method,
+	 [{struct, AuthList} | Arguments] = AllArgs}) ->
+    try get_auth(AuthList) of
+      Auth ->
+	  handler(State#state{get_auth = false, auth = Auth},
+		  {call, Method, Arguments})
+    catch
+      {error, missing_auth_arguments, _Attr} ->
+	  handler(State#state{get_auth = false, auth = noauth},
+		  {call, Method, AllArgs})
+    end;
+%% .............................
+%%  Debug
+%% echothis       String                                          String
+handler(_State, {call, echothis, [A]}) ->
+    {false, {response, [A]}};
+%% echothisnew    struct[{sentence, String}]   struct[{repeated, String}]
+handler(_State,
+	{call, echothisnew, [{struct, [{sentence, A}]}]}) ->
+    {false, {response, [{struct, [{repeated, A}]}]}};
+%% multhis        struct[{a, Integer}, {b, Integer}]              Integer
+handler(_State,
+	{call, multhis, [{struct, [{a, A}, {b, B}]}]}) ->
+    {false, {response, [A * B]}};
+%% multhisnew     struct[{a, Integer}, {b, Integer}]    struct[{mu, Integer}]
+handler(_State,
+	{call, multhisnew, [{struct, [{a, A}, {b, B}]}]}) ->
+    {false, {response, [{struct, [{mu, A * B}]}]}};
+%% .............................
+%% ejabberd commands
+handler(State, {call, Command, []}) ->
+    handler(State, {call, Command, [{struct, []}]});
+handler(State,
+	{call, Command, [{struct, AttrL}]} = Payload) ->
+    case ejabberd_commands:get_command_format(Command) of
+      {error, command_unknown} ->
+	  build_fault_response(-112, "Unknown call: ~p",
+			       [Payload]);
+      {ArgsF, ResultF} ->
+	  try_do_command(State#state.access_commands,
+			 State#state.auth, Command, AttrL, ArgsF, ResultF)
+    end;
+%% If no other guard matches
+handler(_State, Payload) ->
+    build_fault_response(-112, "Unknown call: ~p",
+			 [Payload]).
+
+%% -----------------------------
+%% Command
+%% -----------------------------
+
+try_do_command(AccessCommands, Auth, Command, AttrL,
+	       ArgsF, ResultF) ->
+    try do_command(AccessCommands, Auth, Command, AttrL,
+		   ArgsF, ResultF)
+    of
+      {command_result, ResultFormatted} ->
+	  {false, {response, [ResultFormatted]}}
+    catch
+      exit:{duplicated_attribute, ExitAt, ExitAtL} ->
+	  build_fault_response(-114,
+			       "Attribute '~p' duplicated:~n~p",
+			       [ExitAt, ExitAtL]);
+      exit:{attribute_not_found, ExitAt, ExitAtL} ->
+	  build_fault_response(-116,
+			       "Required attribute '~p' not found:~n~p",
+			       [ExitAt, ExitAtL]);
+      exit:{additional_unused_args, ExitAtL} ->
+	  build_fault_response(-120,
+			       "The call provided additional unused "
+				 "arguments:~n~p",
+			       [ExitAtL]);
+      Why ->
+	  build_fault_response(-118,
+			       "A problem '~p' occurred executing the "
+				 "command ~p with arguments~n~p",
+			       [Why, Command, AttrL])
+    end.
+
+build_fault_response(Code, ParseString, ParseArgs) ->
+    FaultString = "Error " ++ integer_to_list(Code) ++ "\n"
+        ++ lists:flatten(io_lib:format(ParseString, ParseArgs)),
+    ?WARNING_MSG(FaultString, []),
+    {false, {response, {fault, Code, FaultString}}}.
+
+do_command(AccessCommands, Auth, Command, AttrL, ArgsF,
+	   ResultF) ->
+    ArgsFormatted = format_args(AttrL, ArgsF),
+    Result =
+	ejabberd_commands:execute_command(AccessCommands, Auth,
+					  Command, ArgsFormatted),
+    ResultFormatted = format_result(Result, ResultF),
+    {command_result, ResultFormatted}.
+
+%%-----------------------------
+%% Format arguments
+%%-----------------------------
+
+get_attrs(Attribute_names, L) ->
+    [get_attr(A, L) || A <- Attribute_names].
+
+get_attr(A, L) ->
+    case lists:keysearch(A, 1, L) of
+      {value, {A, Value}} -> Value;
+      false ->
+	  %% Report the error and then force a crash
+	  exit({attribute_not_found, A, L})
+    end.
+
+get_elem_delete(A, L) ->
+    case proplists:get_all_values(A, L) of
+      [Value] -> {Value, proplists:delete(A, L)};
+      [_, _ | _] ->
+	  %% Crash reporting the error
+	  exit({duplicated_attribute, A, L});
+      [] ->
+	  %% Report the error and then force a crash
+	  exit({attribute_not_found, A, L})
+    end.
+
+format_args(Args, ArgsFormat) ->
+    {ArgsRemaining, R} = lists:foldl(fun ({ArgName,
+					   ArgFormat},
+					  {Args1, Res}) ->
+					     {ArgValue, Args2} =
+						 get_elem_delete(ArgName,
+								 Args1),
+					     Formatted = format_arg(ArgValue,
+								    ArgFormat),
+					     {Args2, Res ++ [Formatted]}
+				     end,
+				     {Args, []}, ArgsFormat),
+    case ArgsRemaining of
+      [] -> R;
+      L when is_list(L) -> exit({additional_unused_args, L})
+    end.
+
+format_arg({array, Elements},
+	   {list, {ElementDefName, ElementDefFormat}})
+    when is_list(Elements) ->
+    lists:map(fun ({struct, [{ElementName, ElementValue}]}) when
+                        ElementDefName == ElementName ->
+		      format_arg(ElementValue, ElementDefFormat)
+	      end,
+	      Elements);
+format_arg({array, [{struct, Elements}]},
+	   {list, {ElementDefName, ElementDefFormat}})
+    when is_list(Elements) ->
+    lists:map(fun ({ElementName, ElementValue}) ->
+		      true = ElementDefName == ElementName,
+		      format_arg(ElementValue, ElementDefFormat)
+	      end,
+	      Elements);
+format_arg({array, [{struct, Elements}]},
+	   {tuple, ElementsDef})
+    when is_list(Elements) ->
+    FormattedList = format_args(Elements, ElementsDef),
+    list_to_tuple(FormattedList);
+format_arg({array, Elements}, {list, ElementsDef})
+    when is_list(Elements) and is_atom(ElementsDef) ->
+    [format_arg(Element, ElementsDef)
+     || Element <- Elements];
+format_arg(Arg, integer) when is_integer(Arg) -> Arg;
+format_arg(Arg, binary) when is_list(Arg) -> list_to_binary(Arg);
+format_arg(Arg, binary) when is_binary(Arg) -> Arg;
+format_arg(Arg, string) when is_binary(Arg) -> Arg.
+
+%% -----------------------------
+%% Result
+%% -----------------------------
+
+format_result({error, Error}, _) ->
+    throw({error, Error});
+format_result(String, string) -> lists:flatten(String);
+format_result(Atom, {Name, atom}) ->
+    {struct,
+     [{Name, iolist_to_binary(atom_to_list(Atom))}]};
+format_result(Int, {Name, integer}) ->
+    {struct, [{Name, Int}]};
+format_result(String, {Name, string}) when is_list(String) ->
+    {struct, [{Name, lists:flatten(String)}]};
+format_result(Binary, {Name, string}) when is_binary(Binary) ->
+    {struct, [{Name, binary_to_list(Binary)}]};
+format_result(Code, {Name, rescode}) ->
+    {struct, [{Name, make_status(Code)}]};
+format_result({Code, Text}, {Name, restuple}) ->
+    {struct,
+     [{Name, make_status(Code)},
+      {text, lists:flatten(Text)}]};
+%% Result is a list of something: [something()]
+format_result(Elements, {Name, {list, ElementsDef}}) ->
+    FormattedList = lists:map(fun (Element) ->
+				      format_result(Element, ElementsDef)
+			      end,
+			      Elements),
+    {struct, [{Name, {array, FormattedList}}]};
+%% Result is a tuple with several elements: {something1(), something2(), ...}
+format_result(ElementsTuple,
+	      {Name, {tuple, ElementsDef}}) ->
+    ElementsList = tuple_to_list(ElementsTuple),
+    ElementsAndDef = lists:zip(ElementsList, ElementsDef),
+    FormattedList = lists:map(fun ({Element, ElementDef}) ->
+				      format_result(Element, ElementDef)
+			      end,
+			      ElementsAndDef),
+    {struct, [{Name, {array, FormattedList}}]}.
+
+make_status(ok) -> 0;
+make_status(true) -> 0;
+make_status(false) -> 1;
+make_status(error) -> 1;
+make_status(_) -> 1.

src/ejabberd_zlib/Makefile.in

@@ -26,7 +26,7 @@ EFLAGS += -pz ..
 
 # make debug=true to compile Erlang module with debug informations.
 ifdef debug
-	EFLAGS+=+debug_info +export_all
+	EFLAGS+=+debug_info
 endif
 
 ERLSHLIBS = ../ejabberd_zlib_drv.so

src/ejabberd_zlib/ejabberd_zlib.erl

@@ -5,7 +5,7 @@
 %%% Created : 19 Jan 2006 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,169 +25,184 @@
 %%%----------------------------------------------------------------------
 
 -module(ejabberd_zlib).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
 
--export([start/0, start_link/0,
-	 enable_zlib/2, disable_zlib/1,
-	 send/2,
-	 recv/2, recv/3, recv_data/2,
-	 setopts/2,
-	 sockname/1, peername/1,
-	 get_sockmod/1,
-	 controlling_process/2,
-	 close/1]).
+-export([start/0, start_link/0, enable_zlib/2,
+	 disable_zlib/1, send/2, recv/2, recv/3, recv_data/2,
+	 setopts/2, sockname/1, peername/1, get_sockmod/1,
+	 controlling_process/2, close/1]).
 
 %% Internal exports, call-back functions.
--export([init/1,
-	 handle_call/3,
-	 handle_cast/2,
-	 handle_info/2,
-	 code_change/3,
-	 terminate/2]).
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, code_change/3, terminate/2]).
 
 -define(DEFLATE, 1).
+
 -define(INFLATE, 2).
 
--record(zlibsock, {sockmod, socket, zlibport}).
+-record(zlibsock, {sockmod :: atom(),
+                   socket :: inet:socket(),
+                   zlibport :: port()}).
+
+-type zlib_socket() :: #zlibsock{}.
+
+-export_type([zlib_socket/0]).
 
 start() ->
     gen_server:start({local, ?MODULE}, ?MODULE, [], []).
 
 start_link() ->
-    gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+    gen_server:start_link({local, ?MODULE}, ?MODULE, [],
+			  []).
 
 init([]) ->
-    case erl_ddll:load_driver(ejabberd:get_so_path(), ejabberd_zlib_drv) of
-	ok -> ok;
-	{error, already_loaded} -> ok
+    case erl_ddll:load_driver(ejabberd:get_so_path(),
+			      ejabberd_zlib_drv)
+	of
+      ok -> ok;
+      {error, already_loaded} -> ok
     end,
-    Port = open_port({spawn, "ejabberd_zlib_drv"}, [binary]),
+    Port = open_port({spawn, "ejabberd_zlib_drv"},
+		     [binary]),
     {ok, Port}.
 
-
 %%% --------------------------------------------------------
 %%% The call-back functions.
 %%% --------------------------------------------------------
 
-handle_call(_, _, State) ->
-    {noreply, State}.
+handle_call(_, _, State) -> {noreply, State}.
 
-handle_cast(_, State) ->
-    {noreply, State}.
+handle_cast(_, State) -> {noreply, State}.
 
 handle_info({'EXIT', Port, Reason}, Port) ->
     {stop, {port_died, Reason}, Port};
-
 handle_info({'EXIT', _Pid, _Reason}, Port) ->
     {noreply, Port};
+handle_info(_, State) -> {noreply, State}.
 
-handle_info(_, State) ->
-    {noreply, State}.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
 
-code_change(_OldVsn, State, _Extra) ->
-    {ok, State}.
-
-terminate(_Reason, Port) ->
-    Port ! {self, close},
-    ok.
+terminate(_Reason, Port) -> Port ! {self, close}, ok.
 
+-spec enable_zlib(atom(), inet:socket()) -> {ok, zlib_socket()}.
 
 enable_zlib(SockMod, Socket) ->
-    case erl_ddll:load_driver(ejabberd:get_so_path(), ejabberd_zlib_drv) of
-	ok -> ok;
-	{error, already_loaded} -> ok
+    case erl_ddll:load_driver(ejabberd:get_so_path(),
+			      ejabberd_zlib_drv)
+	of
+      ok -> ok;
+      {error, already_loaded} -> ok
     end,
-    Port = open_port({spawn, "ejabberd_zlib_drv"}, [binary]),
-    {ok, #zlibsock{sockmod = SockMod, socket = Socket, zlibport = Port}}.
+    Port = open_port({spawn, "ejabberd_zlib_drv"},
+		     [binary]),
+    {ok,
+     #zlibsock{sockmod = SockMod, socket = Socket,
+	       zlibport = Port}}.
 
-disable_zlib(#zlibsock{sockmod = SockMod, socket = Socket, zlibport = Port}) ->
-    port_close(Port),
-    {SockMod, Socket}.
+-spec disable_zlib(zlib_socket()) -> {atom(), inet:socket()}.
 
-recv(Socket, Length) ->
-    recv(Socket, Length, infinity).
-recv(#zlibsock{sockmod = SockMod, socket = Socket} = ZlibSock,
+disable_zlib(#zlibsock{sockmod = SockMod,
+		       socket = Socket, zlibport = Port}) ->
+    port_close(Port), {SockMod, Socket}.
+
+-spec recv(zlib_socket(), number()) -> {ok, binary()} | {error, any()}.
+
+recv(Socket, Length) -> recv(Socket, Length, infinity).
+
+-spec recv(zlib_socket(), number(), timeout()) -> {ok, binary()} |
+                                                  {error, any()}.
+
+recv(#zlibsock{sockmod = SockMod, socket = Socket} =
+	 ZlibSock,
      Length, Timeout) ->
     case SockMod:recv(Socket, Length, Timeout) of
-	{ok, Packet} ->
-	    recv_data(ZlibSock, Packet);
-	{error, _Reason} = Error ->
-	    Error
+      {ok, Packet} -> recv_data(ZlibSock, Packet);
+      {error, _Reason} = Error -> Error
     end.
 
-recv_data(#zlibsock{sockmod = SockMod, socket = Socket} = ZlibSock, Packet) ->
+-spec recv_data(zlib_socket(), iodata()) -> {ok, binary()} | {error, any()}.
+
+recv_data(#zlibsock{sockmod = SockMod,
+		    socket = Socket} =
+	      ZlibSock,
+	  Packet) ->
     case SockMod of
-	gen_tcp ->
-	    recv_data2(ZlibSock, Packet);
-	_ ->
-	    case SockMod:recv_data(Socket, Packet) of
-		{ok, Packet2} ->
-		    recv_data2(ZlibSock, Packet2);
-		Error ->
-		    Error
-	    end
+      gen_tcp -> recv_data2(ZlibSock, Packet);
+      _ ->
+	  case SockMod:recv_data(Socket, Packet) of
+	    {ok, Packet2} -> recv_data2(ZlibSock, Packet2);
+	    Error -> Error
+	  end
     end.
 
 recv_data2(ZlibSock, Packet) ->
     case catch recv_data1(ZlibSock, Packet) of
-	{'EXIT', Reason} ->
-	    {error, Reason};
-	Res ->
-	    Res
+      {'EXIT', Reason} -> {error, Reason};
+      Res -> Res
     end.
 
-recv_data1(#zlibsock{zlibport = Port} = _ZlibSock, Packet) ->
+recv_data1(#zlibsock{zlibport = Port} = _ZlibSock,
+	   Packet) ->
     case port_control(Port, ?INFLATE, Packet) of
-	<<0, In/binary>> ->
-	    {ok, In};
-	<<1, Error/binary>> ->
-	    {error, binary_to_list(Error)}
+      <<0, In/binary>> -> {ok, In};
+      <<1, Error/binary>> -> {error, (Error)}
     end.
 
-send(#zlibsock{sockmod = SockMod, socket = Socket, zlibport = Port},
+-spec send(zlib_socket(), iodata()) -> ok | {error, binary() | inet:posix()}.
+
+send(#zlibsock{sockmod = SockMod, socket = Socket,
+	       zlibport = Port},
      Packet) ->
     case port_control(Port, ?DEFLATE, Packet) of
-	<<0, Out/binary>> ->
-	    SockMod:send(Socket, Out);
-	<<1, Error/binary>> ->
-	    {error, binary_to_list(Error)}
+      <<0, Out/binary>> -> SockMod:send(Socket, Out);
+      <<1, Error/binary>> -> {error, (Error)}
     end.
 
+-spec setopts(zlib_socket(), list()) -> ok | {error, inet:posix()}.
 
-setopts(#zlibsock{sockmod = SockMod, socket = Socket}, Opts) ->
+setopts(#zlibsock{sockmod = SockMod, socket = Socket},
+	Opts) ->
     case SockMod of
-	gen_tcp ->
-	    inet:setopts(Socket, Opts);
-	_ ->
-	    SockMod:setopts(Socket, Opts)
+      gen_tcp -> inet:setopts(Socket, Opts);
+      _ -> SockMod:setopts(Socket, Opts)
     end.
 
-sockname(#zlibsock{sockmod = SockMod, socket = Socket}) ->
+-spec sockname(zlib_socket()) -> {ok, {inet:ip_address(), inet:port_number()}} |
+                                 {error, inet:posix()}.
+
+sockname(#zlibsock{sockmod = SockMod,
+		   socket = Socket}) ->
     case SockMod of
-	gen_tcp ->
-	    inet:sockname(Socket);
-	_ ->
-	    SockMod:sockname(Socket)
+      gen_tcp -> inet:sockname(Socket);
+      _ -> SockMod:sockname(Socket)
     end.
 
-get_sockmod(#zlibsock{sockmod = SockMod}) ->
-    SockMod.
+-spec get_sockmod(zlib_socket()) -> atom().
 
-peername(#zlibsock{sockmod = SockMod, socket = Socket}) ->
+get_sockmod(#zlibsock{sockmod = SockMod}) -> SockMod.
+
+-spec peername(zlib_socket()) -> {ok, {inet:ip_address(), inet:port_number()}} |
+                                 {error, inet:posix()}.
+
+peername(#zlibsock{sockmod = SockMod,
+		   socket = Socket}) ->
     case SockMod of
-	gen_tcp ->
-	    inet:peername(Socket);
-	_ ->
-	    SockMod:peername(Socket)
+      gen_tcp -> inet:peername(Socket);
+      _ -> SockMod:peername(Socket)
     end.
 
-controlling_process(#zlibsock{sockmod = SockMod, socket = Socket}, Pid) ->
+-spec controlling_process(zlib_socket(), pid()) -> ok | {error, atom()}.
+
+controlling_process(#zlibsock{sockmod = SockMod,
+			      socket = Socket},
+		    Pid) ->
     SockMod:controlling_process(Socket, Pid).
 
-close(#zlibsock{sockmod = SockMod, socket = Socket, zlibport = Port}) ->
-    SockMod:close(Socket),
-    port_close(Port).
-
+-spec close(zlib_socket()) -> true.
 
+close(#zlibsock{sockmod = SockMod, socket = Socket,
+		zlibport = Port}) ->
+    SockMod:close(Socket), port_close(Port).

src/ejabberd_zlib/ejabberd_zlib_drv.c

@@ -1,5 +1,5 @@
 /*
- * ejabberd, Copyright (C) 2002-2012   ProcessOne
+ * ejabberd, Copyright (C) 2002-2013   ProcessOne
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License as

src/ejabberdctl.template

@@ -41,7 +41,9 @@ fi
 if [ "$EJABBERDCTL_CONFIG_PATH" = "" ] ; then
     EJABBERDCTL_CONFIG_PATH=$ETCDIR/ejabberdctl.cfg
 fi
-[ -f "$EJABBERDCTL_CONFIG_PATH" ] && . "$EJABBERDCTL_CONFIG_PATH"
+if [ -f "$EJABBERDCTL_CONFIG_PATH" ] ; then
+    . "$EJABBERDCTL_CONFIG_PATH"
+fi
 if [ "$LOGS_DIR" = "" ] ; then
     LOGS_DIR=@LOCALSTATEDIR@/log/ejabberd
 fi
@@ -53,6 +55,7 @@ if [ "$EJABBERD_DOC_PATH" = "" ] ; then
 fi
 if [ "$ERLANG_NODE_ARG" != "" ] ; then
     ERLANG_NODE=$ERLANG_NODE_ARG
+    NODE=${ERLANG_NODE%@*}
 fi
 
 # check the proper system user is used
@@ -62,19 +65,21 @@ EJID=`id -g $INSTALLUSER`
 EXEC_CMD="false"
 for GID in $GIDS; do
     if [ $GID -eq 0 ] ; then
-	EXEC_CMD="su ${INSTALLUSER} -p -c"
+        EXEC_CMD="su ${INSTALLUSER} -p -c"
     fi
 done
 if [ "$ID" -eq "$EJID" ] ; then
-	EXEC_CMD="sh -c"
+    EXEC_CMD="sh -c"
 fi
 if [ "$EXEC_CMD" = "false" ] ; then
-	echo "This command can only be run by root or the user $INSTALLUSER" >&2
-	exit 4
+    echo "This command can only be run by root or the user $INSTALLUSER" >&2
+    exit 4
 fi
 
 NAME=-name
-[ "$ERLANG_NODE" = "${ERLANG_NODE%.*}" ] && NAME=-sname
+if [ "$ERLANG_NODE" = "${ERLANG_NODE%.*}" ] ; then
+    NAME=-sname
+fi
 
 KERNEL_OPTS=""
 if [ "$FIREWALL_WINDOW" != "" ] ; then
@@ -87,22 +92,22 @@ fi
 ERLANG_OPTS="+K $POLL -smp $SMP +P $ERL_PROCESSES $ERL_OPTIONS"
 
 # define additional environment variables
-if [ "$EJABBERDDIR" = "" ]; then
+if [ "$EJABBERDDIR" = "" ] ; then
     EJABBERDDIR=@LIBDIR@/ejabberd
 fi
-if [ "$EJABBERD_EBIN_PATH" = "" ]; then
+if [ "$EJABBERD_EBIN_PATH" = "" ] ; then
     EJABBERD_EBIN_PATH=$EJABBERDDIR/ebin
 fi
-if [ "$EJABBERD_PRIV_PATH" = "" ]; then
+if [ "$EJABBERD_PRIV_PATH" = "" ] ; then
     EJABBERD_PRIV_PATH=$EJABBERDDIR/priv
 fi
-if [ "$EJABBERD_BIN_PATH" = "" ]; then
+if [ "$EJABBERD_BIN_PATH" = "" ] ; then
     EJABBERD_BIN_PATH=$EJABBERD_PRIV_PATH/bin
 fi
-if [ "$EJABBERD_SO_PATH" = "" ]; then
+if [ "$EJABBERD_SO_PATH" = "" ] ; then
     EJABBERD_SO_PATH=$EJABBERD_PRIV_PATH/lib
 fi
-if [ "$EJABBERD_MSGS_PATH" = "" ]; then
+if [ "$EJABBERD_MSGS_PATH" = "" ] ; then
     EJABBERD_MSGS_PATH=$EJABBERD_PRIV_PATH/msgs
 fi
 
@@ -143,6 +148,7 @@ export EXEC_CMD
 # start server
 start ()
 {
+    check_start
     $EXEC_CMD "$ERL \
       $NAME $ERLANG_NODE \
       -noinput -detached \
@@ -174,7 +180,7 @@ debug ()
     echo "  EJABBERD_BYPASS_WARNINGS=true"
     echo "Press any key to continue"
     if [ "$EJABBERD_BYPASS_WARNINGS" != "true" ] ; then
-	read foo
+        read foo
     fi
     echo ""
     TTY=`tty | sed -e  's/.*\///g'`
@@ -189,6 +195,7 @@ debug ()
 # start interactive server
 live ()
 {
+    check_start
     echo "--------------------------------------------------------------------"
     echo ""
     echo "IMPORTANT: ejabberd is going to start in LIVE (interactive) mode."
@@ -205,7 +212,7 @@ live ()
     echo "  EJABBERD_BYPASS_WARNINGS=true"
     echo "Press any key to continue"
     if [ "$EJABBERD_BYPASS_WARNINGS" != "true" ] ; then
-	read foo
+        read foo
     fi
     echo ""
     $EXEC_CMD "$ERL \
@@ -217,6 +224,13 @@ live ()
       $ERLANG_OPTS $ARGS \"$@\""
 }
 
+etop()
+{
+    $EXEC_CMD "$ERL \
+      $NAME debug-${TTY}-${ERLANG_NODE} \
+      -hidden -s etop -s erlang halt -output text -node $ERLANG_NODE"
+}
+
 help ()
 {
     echo ""
@@ -247,66 +261,66 @@ ctl ()
     CONNLOCKDIR=@LOCALSTATEDIR@/lock/ejabberdctl
     FLOCK='/usr/bin/flock'
     if [ ! -x "$FLOCK" ] || [ ! -d "$CONNLOCKDIR" ] ; then
-	JOT='/usr/bin/jot'
-	if [ ! -x "$JOT" ] ; then
-	    # no flock or jot, simply invoke ctlexec()
-	    CTL_CONN="ctl-${ERLANG_NODE}"
-	    ctlexec $CTL_CONN $COMMAND
-	    result=$?
-	else
-	    # no flock, but at least there is jot
-	    RAND=`jot -r 1 0 $MAXCONNID`
-	    CTL_CONN="ctl-${RAND}-${ERLANG_NODE}"
-	    ctlexec $CTL_CONN $COMMAND
-	    result=$?
-	fi
+        JOT='/usr/bin/jot'
+        if [ ! -x "$JOT" ] ; then
+            # no flock or jot, simply invoke ctlexec()
+            CTL_CONN="ctl-${ERLANG_NODE}"
+            ctlexec $CTL_CONN $COMMAND
+            result=$?
+        else
+            # no flock, but at least there is jot
+            RAND=`jot -r 1 0 $MAXCONNID`
+            CTL_CONN="ctl-${RAND}-${ERLANG_NODE}"
+            ctlexec $CTL_CONN $COMMAND
+            result=$?
+        fi
     else
-	# we have flock so we get a lock
-	# on one of a limited number of
-	# conn names -- this allows
-	# concurrent invocations using a bound
-	# number of atoms
-	for N in $(seq 1 $MAXCONNID); do
-	    CTL_CONN="ejabberdctl-$N"
-	    CTL_LOCKFILE="$CONNLOCKDIR/$CTL_CONN"
-	    (
-		exec 8>"$CTL_LOCKFILE"
-		if flock --nb 8; then
-		    ctlexec $CTL_CONN $COMMAND
+        # we have flock so we get a lock
+        # on one of a limited number of
+        # conn names -- this allows
+        # concurrent invocations using a bound
+        # number of atoms
+        for N in $(seq 1 $MAXCONNID); do
+            CTL_CONN="ejabberdctl-$N"
+            CTL_LOCKFILE="$CONNLOCKDIR/$CTL_CONN"
+            (
+                exec 8>"$CTL_LOCKFILE"
+                if flock --nb 8; then
+                    ctlexec $CTL_CONN $COMMAND
                     ssresult=$?
                     # segregate from possible flock exit(1)
-		    ssresult=$(expr $ssresult \* 10)
-		    exit $ssresult
-		else
-		    exit 1
-		fi
+                    ssresult=$(expr $ssresult \* 10)
+                    exit $ssresult
+                else
+                    exit 1
+                fi
             )
-	    result=$?
-	    if [ $result -eq 1 ]; then
+            result=$?
+            if [ $result -eq 1 ] ; then
                 # means we errored out in flock
                 # rather than in the exec - stay in the loop
                 # trying other conn names...
-		badlock=1
-	    else
-		badlock=""
-		break;
-	    fi
-	done
-	result=$(expr $result / 10)
+                badlock=1
+            else
+                badlock=""
+                break;
+            fi
+        done
+        result=$(expr $result / 10)
     fi
 
-    if [ "$badlock" ];then
-	echo "Ran out of connections to try. Your ejabberd processes" >&2
-	echo "may be stuck or this is a very busy server. For very"   >&2
-	echo "busy servers, consider raising MAXCONNID in ejabberdctl">&2
-	exit 1;
+    if [ "$badlock" ] ;then
+        echo "Ran out of connections to try. Your ejabberd processes" >&2
+        echo "may be stuck or this is a very busy server. For very"   >&2
+        echo "busy servers, consider raising MAXCONNID in ejabberdctl">&2
+        exit 1;
     fi
 
     case $result in
-	0) :;;
-	1) :;;
-	2) help;;
-	3) help;;
+        0) :;;
+        1) :;;
+        2) help;;
+        3) help;;
     esac
     return $result
 }
@@ -337,6 +351,26 @@ stop_epmd()
     epmd -names | grep -q name || epmd -kill
 }
 
+# make sure node not already running and node name unregistered
+check_start()
+{
+    epmd -names | grep -q $NODE && {
+        ps ux | grep -v grep | grep -q $ERLANG_NODE && {
+            echo "ERROR: The ejabberd node '$ERLANG_NODE' is already running."
+            exit 4
+        } || {
+            ps ux | grep beam | grep -v "grep beam" && {
+                echo "ERROR: The ejabberd node '$ERLANG_NODE' is registered,"
+                echo "       but no ejabberd process has been found."
+                echo "Shutdown other erlang nodes, and call 'epmd -kill'."
+                exit 5
+            } || {
+                epmd -kill
+            }
+        }
+    }
+}
+
 # allow sync calls
 wait_for_status()
 {
@@ -344,7 +378,7 @@ wait_for_status()
     # return: 0 OK, 1 KO
     timeout=$2
     status=4
-    while [ $status -ne $1 ]; do
+    while [ $status -ne $1 ] ; do
         sleep $3
         timeout=$(($timeout - 1))
         [ $timeout -eq 0 ] && {
@@ -366,6 +400,7 @@ case $ARGS in
     ' start') start;;
     ' debug') debug;;
     ' live') live;;
+    ' etop') etop;;
     ' started') wait_for_status 0 30 2;; # wait 30x2s before timeout
     ' stopped') wait_for_status 3 15 2; stop_epmd;; # wait 15x2s before timeout
     *) ctl $ARGS;;

src/ejd2odbc.erl

@@ -5,7 +5,7 @@
 %%% Created : 22 Aug 2005 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,59 +25,12 @@
 %%%----------------------------------------------------------------------
 
 -module(ejd2odbc).
+
 -author('alexey@process-one.net').
 
-%% External exports
--export([export_passwd/2,
-	 export_roster/2,
-	 export_offline/2,
-	 export_last/2,
-	 export_vcard/2,
-	 export_vcard_search/2,
-         export_vcard_xupdate/2,
-	 export_private_storage/2,
-         export_privacy/2,
-         export_motd/2,
-         export_motd_users/2,
-         export_irc_custom/2,
-         export_sr_group/2,
-         export_sr_user/2,
-         export_muc_room/2,
-         export_muc_registered/2]).
+-export([export/2, export/3]).
 
--include("ejabberd.hrl").
--include("jlib.hrl").
--include("mod_roster.hrl").
--include("mod_privacy.hrl").
-
--record(offline_msg, {us, timestamp, expire, from, to, packet}).
--record(last_activity, {us, timestamp, status}).
--record(vcard, {us, vcard}).
--record(vcard_xupdate, {us, hash}).
--record(vcard_search, {us,
-		       user,     luser,
-		       fn,	 lfn,
-		       family,	 lfamily,
-		       given,	 lgiven,
-		       middle,	 lmiddle,
-		       nickname, lnickname,
-		       bday,	 lbday,
-		       ctry,	 lctry,
-		       locality, llocality,
-		       email,	 lemail,
-		       orgname,	 lorgname,
-		       orgunit,	 lorgunit
-		      }).
--record(private_storage, {usns, xml}).
--record(irc_custom, {us_host, data}).
--record(muc_room, {name_host, opts}).
--record(muc_registered, {us_host, nick}).
--record(sr_group, {group_host, opts}).
--record(sr_user, {us, group_host}).
--record(motd, {server, packet}).
--record(motd_users, {us, dummy = []}).
-
--define(MAX_RECORDS_PER_TRANSACTION, 1000).
+-define(MAX_RECORDS_PER_TRANSACTION, 100).
 
 %%%----------------------------------------------------------------------
 %%% API
@@ -88,476 +41,98 @@
 %%% - Server is the server domain you want to convert
 %%% - Output can be either odbc to export to the configured relational
 %%%   database or "Filename" to export to text file.
+export(Server, Output) ->
+    LServer = jlib:nameprep(iolist_to_binary(Server)),
+    Modules = [ejabberd_auth,
+               mod_announce,
+               mod_caps,
+               mod_irc,
+               mod_last,
+               mod_muc,
+               mod_offline,
+               mod_privacy,
+               mod_private,
+               mod_roster,
+               mod_shared_roster,
+               mod_vcard,
+               mod_vcard_xupdate],
+    IO = prepare_output(Output),
+    lists:foreach(
+      fun(Module) ->
+              export(LServer, IO, Module)
+      end, Modules),
+    close_output(Output, IO).
 
-export_passwd(Server, Output) ->
-    export_common(
-      Server, passwd, Output,
-      fun(Host, {passwd, {LUser, LServer}, Password} = _R)
-	 when LServer == Host ->
-	      Username = ejabberd_odbc:escape(LUser),
-	      Pass = ejabberd_odbc:escape(Password),
-	      ["delete from users where username='", Username ,"';"
-	       "insert into users(username, password) "
-	       "values ('", Username, "', '", Pass, "');"];
-	 (_Host, _R) ->
-	      []
-      end).
-
-export_roster(Server, Output) ->
-    export_common(
-      Server, roster, Output,
-      fun(Host, #roster{usj = {LUser, LServer, LJID}} = R)
-	 when LServer == Host ->
-	      Username = ejabberd_odbc:escape(LUser),
-	      SJID = ejabberd_odbc:escape(jlib:jid_to_string(LJID)),
-	      ItemVals = record_to_string(R),
-	      ItemGroups = groups_to_string(R),
-	      ["delete from rosterusers "
-	       "      where username='", Username, "' "
-	       "        and jid='", SJID, "';"
-	       "insert into rosterusers("
-	       "              username, jid, nick, "
-	       "              subscription, ask, askmessage, "
-	       "              server, subscribe, type) "
-	       " values ", ItemVals, ";"
-	       "delete from rostergroups "
-	       "      where username='", Username, "' "
-	       "        and jid='", SJID, "';",
-	       [["insert into rostergroups("
-		 "              username, jid, grp) "
-		 " values ", ItemGroup, ";"] ||
-		   ItemGroup <- ItemGroups]];
-	 (_Host, _R) ->
-	      []
-      end).
-
-export_offline(Server, Output) ->
-    export_common(
-      Server, offline_msg, Output,
-      fun(Host, #offline_msg{us = {LUser, LServer},
-			     timestamp = TimeStamp,
-			     from = From,
-			     to = To,
-			     packet = Packet})
-	 when LServer == Host ->
-	      Username = ejabberd_odbc:escape(LUser),
-	      {xmlelement, Name, Attrs, Els} = Packet,
-	      Attrs2 = jlib:replace_from_to_attrs(
-			 jlib:jid_to_string(From),
-			 jlib:jid_to_string(To),
-			 Attrs),
-	      NewPacket = {xmlelement, Name, Attrs2,
-			   Els ++
-			   [jlib:timestamp_to_xml(
-			      calendar:now_to_universal_time(TimeStamp),
-			      utc,
-			      jlib:make_jid("", Server, ""),
-			      "Offline Storage"),
-			    %% TODO: Delete the next three lines once XEP-0091 is Obsolete
-			    jlib:timestamp_to_xml(
-			      calendar:now_to_universal_time(
-				TimeStamp))]},
-	      XML =
-		  ejabberd_odbc:escape(
-		    xml:element_to_binary(NewPacket)),
-	      ["insert into spool(username, xml) "
-	       "values ('", Username, "', '",
-	       XML,
-	       "');"];
-	 (_Host, _R) ->
-	      []
-      end).
-
-export_last(Server, Output) ->
-    export_common(
-      Server, last_activity, Output,
-      fun(Host, #last_activity{us = {LUser, LServer},
-			       timestamp = TimeStamp,
-			       status = Status})
-	 when LServer == Host ->
-	      Username = ejabberd_odbc:escape(LUser),
-	      Seconds = ejabberd_odbc:escape(integer_to_list(TimeStamp)),
-	      State = ejabberd_odbc:escape(Status),
-	      ["delete from last where username='", Username, "';"
-	       "insert into last(username, seconds, state) "
-	       "values ('", Username, "', '", Seconds, "', '", State, "');"];
-	 (_Host, _R) ->
-	      []
-      end).
-
-export_vcard(Server, Output) ->
-    export_common(
-      Server, vcard, Output,
-      fun(Host, #vcard{us = {LUser, LServer},
-		       vcard = VCARD})
-	 when LServer == Host ->
-	      Username = ejabberd_odbc:escape(LUser),
-	      SVCARD = ejabberd_odbc:escape(
-			 xml:element_to_binary(VCARD)),
-	      ["delete from vcard where username='", Username, "';"
-	       "insert into vcard(username, vcard) "
-	       "values ('", Username, "', '", SVCARD, "');"];
-	 (_Host, _R) ->
-	      []
-      end).
-
-export_vcard_search(Server, Output) ->
-    export_common(
-      Server, vcard_search, Output,
-      fun(Host, #vcard_search{user      = {User, LServer},
-			      luser     = LUser,
-			      fn        = FN,       lfn        = LFN,       
-			      family    = Family,   lfamily    = LFamily,   
-			      given     = Given,    lgiven     = LGiven,    
-			      middle    = Middle,   lmiddle    = LMiddle,   
-			      nickname  = Nickname, lnickname  = LNickname, 
-			      bday      = BDay,     lbday      = LBDay,     
-			      ctry      = CTRY,     lctry      = LCTRY,     
-			      locality  = Locality, llocality  = LLocality, 
-			      email     = EMail,    lemail     = LEMail,    
-			      orgname   = OrgName,  lorgname   = LOrgName,  
-			      orgunit   = OrgUnit,  lorgunit   = LOrgUnit   
-			     })
-	 when LServer == Host ->
-	      Username = ejabberd_odbc:escape(User),
-	      LUsername = ejabberd_odbc:escape(LUser),
-
-	      SFN = ejabberd_odbc:escape(FN),
-	      SLFN = ejabberd_odbc:escape(LFN),
-	      SFamily = ejabberd_odbc:escape(Family),
-	      SLFamily = ejabberd_odbc:escape(LFamily),
-	      SGiven = ejabberd_odbc:escape(Given),
-	      SLGiven = ejabberd_odbc:escape(LGiven),
-	      SMiddle = ejabberd_odbc:escape(Middle),
-	      SLMiddle = ejabberd_odbc:escape(LMiddle),
-	      SNickname = ejabberd_odbc:escape(Nickname),
-	      SLNickname = ejabberd_odbc:escape(LNickname),
-	      SBDay = ejabberd_odbc:escape(BDay),
-	      SLBDay = ejabberd_odbc:escape(LBDay),
-	      SCTRY = ejabberd_odbc:escape(CTRY),
-	      SLCTRY = ejabberd_odbc:escape(LCTRY),
-	      SLocality = ejabberd_odbc:escape(Locality),
-	      SLLocality = ejabberd_odbc:escape(LLocality),
-	      SEMail = ejabberd_odbc:escape(EMail),
-	      SLEMail = ejabberd_odbc:escape(LEMail),
-	      SOrgName = ejabberd_odbc:escape(OrgName),
-	      SLOrgName = ejabberd_odbc:escape(LOrgName),
-	      SOrgUnit = ejabberd_odbc:escape(OrgUnit),
-	      SLOrgUnit = ejabberd_odbc:escape(LOrgUnit),
-
-	      ["delete from vcard_search where lusername='", LUsername, "';"
-	       "insert into vcard_search("
-	       "        username, lusername, fn, lfn, family, lfamily,"
-	       "        given, lgiven, middle, lmiddle, nickname, lnickname,"
-	       "        bday, lbday, ctry, lctry, locality, llocality,"
-	       "        email, lemail, orgname, lorgname, orgunit, lorgunit)"
-	       "values (",
-	       "        '", Username, "', '",  LUsername, "'," 
-	       "        '", SFN,       "', '", SLFN,       "'," 
-	       "        '", SFamily,   "', '", SLFamily,   "',"
-	       "        '", SGiven,    "', '", SLGiven,	 "',"
-	       "        '", SMiddle,   "', '", SLMiddle,   "',"
-	       "        '", SNickname, "', '", SLNickname, "',"
-	       "        '", SBDay,     "', '", SLBDay,	 "',"
-	       "        '", SCTRY,     "', '", SLCTRY,	 "',"
-	       "        '", SLocality, "', '", SLLocality, "',"
-	       "        '", SEMail,    "', '", SLEMail,	 "',"
-	       "        '", SOrgName,  "', '", SLOrgName,  "',"
-	       "        '", SOrgUnit,  "', '", SLOrgUnit,  "');"];
-	 (_Host, _R) ->
-	      []
-      end).
-
-export_vcard_xupdate(Server, Output) ->
-    export_common(
-      Server, vcard_xupdate, Output,
-      fun(Host, #vcard_xupdate{us = {LUser, LServer}, hash = Hash})
-            when LServer == Host ->
-	      Username = ejabberd_odbc:escape(LUser),
-	      SHash = ejabberd_odbc:escape(Hash),
-	      ["delete from vcard_xupdate where username='", Username, "';"
-	       "insert into vcard_xupdate(username, hash) "
-	       "values ('", Username, "', '", SHash, "');"];
-	 (_Host, _R) ->
-	      []
-      end).
-
-export_private_storage(Server, Output) ->
-    export_common(
-      Server, private_storage, Output,
-      fun(Host, #private_storage{usns = {LUser, LServer, XMLNS},
-				 xml = Data})
-	 when LServer == Host ->
-	      Username = ejabberd_odbc:escape(LUser),
-      	      LXMLNS = ejabberd_odbc:escape(XMLNS),
-	      SData = ejabberd_odbc:escape(
-			xml:element_to_binary(Data)),
-      	      odbc_queries:set_private_data_sql(Username, LXMLNS, SData);
-	 (_Host, _R) ->
-      	      []
-      end).
-
-export_muc_room(Server, Output) ->
-    export_common(
-      Server, muc_room, Output,
-      fun(Host, #muc_room{name_host = {Name, RoomHost}, opts = Opts}) ->
-              case lists:suffix(Host, RoomHost) of
-                  true ->
-                      SName = ejabberd_odbc:escape(Name),
-                      SRoomHost = ejabberd_odbc:escape(RoomHost),
-                      SOpts = ejabberd_odbc:encode_term(Opts),
-                      ["delete from muc_room where name='", SName,
-                       "' and host='", SRoomHost, "';",
-                       "insert into muc_room(name, host, opts) values (",
-                       "'", SName, "', '", SRoomHost, "', '", SOpts, "');"];
-                  false ->
-                      []
-              end
-      end).
-
-export_muc_registered(Server, Output) ->
-    export_common(
-      Server, muc_registered, Output,
-      fun(Host, #muc_registered{us_host = {{U, S}, RoomHost}, nick = Nick}) ->
-              case lists:suffix(Host, RoomHost) of
-                  true ->
-                      SJID = ejabberd_odbc:escape(
-                               jlib:jid_to_string(
-                                 jlib:make_jid(U, S, ""))),
-                      SNick = ejabberd_odbc:escape(Nick),
-                      SRoomHost = ejabberd_odbc:escape(RoomHost),
-                      ["delete from muc_registered where jid='", SJID,
-                       "' and host='", SRoomHost, "';"
-                       "insert into muc_registered(jid, host, nick) values ("
-                       "'", SJID, "', '", SRoomHost, "', '", SNick, "');"];
-                  false ->
-                      []
-              end
-      end).
-
-export_irc_custom(Server, Output) ->
-    export_common(
-      Server, irc_custom, Output,
-      fun(Host, #irc_custom{us_host = {{U, S}, IRCHost}, data = Data}) ->
-              case lists:suffix(Host, IRCHost) of
-                  true ->
-                      SJID = ejabberd_odbc:escape(
-                               jlib:jid_to_string(
-                                 jlib:make_jid(U, S, ""))),
-                      SIRCHost = ejabberd_odbc:escape(IRCHost),
-                      SData = ejabberd_odbc:encode_term(Data),
-                      ["delete from irc_custom where jid='", SJID,
-                       "' and host='", SIRCHost, "';"
-                       "insert into irc_custom(jid, host, data) values ("
-                       "'", SJID, "', '", SIRCHost, "', '", SData, "');"];
-                  false ->
-                      []
-              end
-      end).
-
-export_privacy(Server, Output) ->
-    case ejabberd_odbc:sql_query(
-           jlib:nameprep(Server),
-           ["select id from privacy_list order by id desc limit 1;"]) of
-        {selected, ["id"], [{I}]} ->
-            put(id, list_to_integer(I));
-        _ ->
-            put(id, 0)
-    end,
-    export_common(
-      Server, privacy, Output,
-      fun(Host, #privacy{us = {LUser, LServer},
-                         lists = Lists,
-                         default = Default}) when LServer == Host ->
-              Username = ejabberd_odbc:escape(LUser),
-              if Default /= none ->
-                      SDefault = ejabberd_odbc:escape(Default),
-                      ["delete from privacy_default_list where ",
-                       "username='", Username, "';",
-                       "insert into privacy_default_list(username, name) ",
-                       "values ('", Username, "', '", SDefault, "');"];
-                 true ->
-                      []
-              end ++
-                  lists:flatmap(
-                    fun({Name, List}) ->
-                            SName = ejabberd_odbc:escape(Name),
-                            RItems = lists:map(
-                                       fun mod_privacy:item_to_raw/1,
-                                       List),
-                            ID = integer_to_list(get_id()),
-                            ["delete from privacy_list "
-                             "where username='", Username, "' and name='", SName, "';"
-                             "insert into privacy_list(username, name, id) "
-                             "values ('", Username, "', '", SName, "', '", ID, "');",
-                             "delete from privacy_list_data where id='", ID, "';"
-                             |[["insert into privacy_list_data("
-                                "id, t, value, action, ord, match_all, match_iq, "
-                                "match_message, match_presence_in, "
-                                "match_presence_out) values ('", ID, "', '",
-                                string:join(Items, "', '"), "');"] || Items <- RItems]]
-                    end, Lists);
-         (_Host, _R) ->
-              []
-      end).
-
-export_sr_group(Server, Output) ->
-    export_common(
-      Server, sr_group, Output,
-      fun(Host, #sr_group{group_host = {Group, LServer}, opts = Opts})
-            when LServer == Host ->
-              SGroup = ejabberd_odbc:escape(Group),
-              SOpts = ejabberd_odbc:encode_term(Opts),
-              ["delete from sr_group where name='", Group, "';"
-               "insert into sr_group(name, opts) values ('",
-               SGroup, "', '", SOpts, "');"];
-         (_Host, _R) ->
-              []
-      end).
-
-export_sr_user(Server, Output) ->
-    export_common(
-      Server, sr_user, Output,
-      fun(Host, #sr_user{us = {U, S}, group_host = {Group, LServer}})
-            when LServer == Host ->
-              SGroup = ejabberd_odbc:escape(Group),
-              SJID = ejabberd_odbc:escape(
-                       jlib:jid_to_string(
-                         jlib:jid_tolower(
-                           jlib:make_jid(U, S, "")))),
-              ["delete from sr_user where jid='", SJID,
-               "'and grp='", Group, "';"
-               "insert into sr_user(jid, grp) values ('",
-               SJID, "', '", SGroup, "');"];
-         (_Host, _R) ->
-              []
-      end).
-
-export_motd(Server, Output) ->
-    export_common(
-      Server, motd, Output,
-      fun(Host, #motd{server = LServer, packet = El})
-            when LServer == Host ->
-              ["delete from motd where username='';"
-               "insert into motd(username, xml) values ('', '",
-               ejabberd_odbc:escape(xml:element_to_binary(El)), "');"];
-         (_Host, _R) ->
-              []
-      end).
-
-export_motd_users(Server, Output) ->
-    export_common(
-      Server, motd_users, Output,
-      fun(Host, #motd_users{us = {LUser, LServer}})
-            when LServer == Host, LUser /= "" ->
-              Username = ejabberd_odbc:escape(LUser),
-              ["delete from motd where username='", Username, "';"
-               "insert into motd(username, xml) values ('",
-               Username, "', '');"];
-         (_Host, _R) ->
-              []
-      end).
+export(Server, Output, Module) ->
+    LServer = jlib:nameprep(iolist_to_binary(Server)),
+    IO = prepare_output(Output),
+    lists:foreach(
+      fun({Table, ConvertFun}) ->
+              export(LServer, Table, IO, ConvertFun)
+      end, Module:export(Server)),
+    close_output(Output, IO).
 
 %%%----------------------------------------------------------------------
 %%% Internal functions
 %%%----------------------------------------------------------------------
+export(LServer, Table, IO, ConvertFun) ->
+    F = fun () ->
+                mnesia:read_lock_table(Table),
+                {_N, SQLs} =
+                    mnesia:foldl(
+                      fun(R, {N, SQLs} = Acc) ->
+                              case ConvertFun(LServer, R) of
+                                  [] ->
+                                      Acc;
+                                  SQL ->
+                                      if N < (?MAX_RECORDS_PER_TRANSACTION) - 1 ->
+                                              {N + 1, [SQL | SQLs]};
+                                         true ->
+                                              output(LServer,
+                                                     Table, IO,
+                                                     flatten([SQL | SQLs])),
+                                              {0, []}
+                                      end
+                              end
+                      end,
+                      {0, []}, Table),
+                output(LServer, Table, IO, flatten(SQLs))
+        end,
+    mnesia:transaction(F).
 
-export_common(Server, Table, Output, ConvertFun) ->
-    IO = case Output of
-	     odbc ->
-		 odbc;
-	     _ ->
-		 {ok, IODevice} = file:open(Output, [write, raw]),
-		 IODevice
-	 end,
-    mnesia:transaction(
-      fun() ->
-	      mnesia:read_lock_table(Table),
-	      LServer = jlib:nameprep(Server),
-	      {_N, SQLs} =
-		  mnesia:foldl(
-		    fun(R, {N, SQLs} = Acc) ->
-			    case ConvertFun(LServer, R) of
-				[] ->
-				    Acc;
-				SQL ->
-				    if
-					N < ?MAX_RECORDS_PER_TRANSACTION - 1 ->
-					    {N + 1, [SQL | SQLs]};
-					true ->
-					    %% Execute full SQL transaction
-					    output(LServer, IO,
-						   ["begin;",
-						    lists:reverse([SQL | SQLs]),
-						    "commit"]),
-					    {0, []}
-				    end
-			    end
-		    end, {0, []}, Table),
-		  %% Execute SQL transaction with remaining records
-	      output(LServer, IO,
-		     ["begin;",
-		      lists:reverse(SQLs),
-		      "commit"])
-      end).
+output(_LServer, _Table, _IO, []) ->
+    ok;
+output(LServer, _Table, odbc, SQLs) ->
+    ejabberd_odbc:sql_transaction(LServer, SQLs);
+output(_LServer, Table, Fd, SQLs) ->
+    file:write(Fd, ["-- \n-- Mnesia table: ", atom_to_list(Table),
+                    "\n--\n", SQLs]).
 
-output(LServer, IO, SQL) ->
-    case IO of
-	odbc ->
-	    catch ejabberd_odbc:sql_query(LServer, SQL);
-	_ ->
-	    file:write(IO, [SQL, $;, $\n])
-    end.
+prepare_output(FileName) when is_list(FileName); is_binary(FileName) ->
+    case file:open(FileName, [write, raw]) of
+        {ok, Fd} ->
+            Fd;
+        Err ->
+            exit(Err)
+    end;
+prepare_output(Output) ->
+    Output.
 
-record_to_string(#roster{usj = {User, _Server, JID},
-			 name = Name,
-			 subscription = Subscription,
-			 ask = Ask,
-			 askmessage = AskMessage}) ->
-    Username = ejabberd_odbc:escape(User),
-    SJID = ejabberd_odbc:escape(jlib:jid_to_string(JID)),
-    Nick = ejabberd_odbc:escape(Name),
-    SSubscription = case Subscription of
-			both -> "B";
-			to   -> "T";
-			from -> "F";
-			none -> "N"
-		    end,
-    SAsk = case Ask of
-	       subscribe   -> "S";
-	       unsubscribe -> "U";
-	       both	   -> "B";
-	       out	   -> "O";
-	       in	   -> "I";
-	       none	   -> "N"
-	   end,
-    SAskMessage =
-	case catch ejabberd_odbc:escape(
-		     binary_to_list(list_to_binary([AskMessage]))) of
-	    {'EXIT', _Reason} ->
-		[];
-	    SAM ->
-		SAM
-	end,
-    ["("
-     "'", Username, "',"
-     "'", SJID, "',"
-     "'", Nick, "',"
-     "'", SSubscription, "',"
-     "'", SAsk, "',"
-     "'", SAskMessage, "',"
-     "'N', '', 'item')"].
+close_output(FileName, Fd) when FileName /= Fd ->
+    file:close(Fd),
+    ok;
+close_output(_, _) ->
+    ok.
 
-groups_to_string(#roster{usj = {User, _Server, JID},
-			 groups = Groups}) ->
-    Username = ejabberd_odbc:escape(User),
-    SJID = ejabberd_odbc:escape(jlib:jid_to_string(JID)),
-    [["("
-      "'", Username, "',"
-      "'", SJID, "',"
-      "'", ejabberd_odbc:escape(Group), "')"] || Group <- Groups].
+flatten(SQLs) ->
+    flatten(SQLs, []).
 
-get_id() ->
-    ID = get(id),
-    put(id, ID+1),
-    ID+1.
+flatten([L|Ls], Acc) ->
+    flatten(Ls, flatten1(lists:reverse(L), Acc));
+flatten([], Acc) ->
+    Acc.
+
+flatten1([H|T], Acc) ->
+    flatten1(T, [[H, $\n]|Acc]);
+flatten1([], Acc) ->
+    Acc.

src/eldap/Makefile.in

@@ -6,7 +6,7 @@ CPPFLAGS = @CPPFLAGS@
 LDFLAGS = @LDFLAGS@
 LIBS = @LIBS@
 
-ASN_FLAGS = -bber_bin +optimize
+ASN_FLAGS = -bber_bin +optimize +binary_strings
 
 ERLANG_CFLAGS = @ERLANG_CFLAGS@
 ERLANG_LIBS = @ERLANG_LIBS@
@@ -17,7 +17,7 @@ EFLAGS += -pz ..
 
 # make debug=true to compile Erlang module with debug informations.
 ifdef debug
-	EFLAGS+=+debug_info +export_all
+	EFLAGS+=+debug_info
 endif
 
 OUTDIR = ..
@@ -31,6 +31,8 @@ ELDAPv3.beam: ELDAPv3.erl
 
 ELDAPv3.erl:       ELDAPv3.asn
 	@ERLC@ $(ASN_FLAGS) -W $(EFLAGS) $<
+	@ERL@ -noinput +B -eval \
+	'case file:read_file("ELDAPv3.erl") of {ok, Data} -> NewData = re:replace(Data, "\\?RT_BER:decode_octet_string", "eldap_utils:decode_octet_string", [global]), file:write_file("ELDAPv3.erl", NewData), halt(0); _Err -> halt(1) end'
 
 eldap_filter_yecc.beam: eldap_filter_yecc.erl
 

src/eldap/eldap.hrl

@@ -1,6 +1,6 @@
 %%%----------------------------------------------------------------------
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -20,20 +20,46 @@
 %%%----------------------------------------------------------------------
 
 -define(LDAP_PORT, 389).
+
 -define(LDAPS_PORT, 636).
 
--record(eldap_search, {scope = wholeSubtree,
-		       base = [],
-		       filter,
-		       limit = 0,
-		       attributes = [],
-		       types_only = false,
-                       deref_aliases = neverDerefAliases,
-		       timeout = 0}).
+-type scope() :: baseObject | singleLevel | wholeSubtree.
 
+-record(eldap_search,
+	{scope = wholeSubtree              :: scope(),
+         base = <<"">>                     :: binary(),
+         filter                            :: eldap:filter(),
+         limit = 0                         :: non_neg_integer(),
+	 attributes = []                   :: [binary()],
+         types_only = false                :: boolean(),
+	 deref_aliases = neverDerefAliases :: neverDerefAliases |
+                                              derefInSearching |
+                                              derefFindingBaseObj |
+                                              derefAlways,
+         timeout = 0                       :: non_neg_integer()}).
 
--record(eldap_search_result, {entries,
-			      referrals}).
+-record(eldap_search_result, {entries = []   :: [eldap_entry()],
+                              referrals = [] :: list()}).
 
--record(eldap_entry, {object_name,
-		      attributes}).
+-record(eldap_entry, {object_name = <<>> :: binary(),
+                      attributes = []    :: [{binary(), [binary()]}]}).
+
+-type tlsopts() :: [{encrypt, tls | starttls | none} |
+                    {tls_cacertfile, binary() | undefined} |
+                    {tls_certfile, binary() | undefined} |
+                    {tls_depth, non_neg_integer() | undefined} |
+                    {tls_verify, hard | soft | false}].
+
+-record(eldap_config, {servers = [] :: [binary()],
+                       backups = [] :: [binary()],
+                       tls_options = [] :: tlsopts(),
+                       port = ?LDAP_PORT :: inet:port_number(),
+                       dn = <<"">> :: binary(),
+                       password = <<"">> :: binary(),
+                       base = <<"">> :: binary(),
+                       deref_aliases = never :: never | searching |
+                                                finding | always}).
+
+-type eldap_config() :: #eldap_config{}.
+-type eldap_search() :: #eldap_search{}.
+-type eldap_entry() :: #eldap_entry{}.

src/eldap/eldap_filter.erl

@@ -6,7 +6,7 @@
 %%% Author:  Evgeniy Khramtsov <ekhramtsov@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -26,9 +26,6 @@
 %%%----------------------------------------------------------------------
 -module(eldap_filter).
 
-%% TODO: remove this when new regexp module will be used
--compile({nowarn_deprecated_function, {regexp, sub, 3}}).
-
 -export([parse/1, parse/2, do_sub/2]).
 
 %%====================================================================
@@ -50,7 +47,9 @@
 %%%   {ok,{'and',[{'not',{lessOrEqual,{'AttributeValueAssertion',"uid","100"}}},
 %%%           {present,"mail"}]}}
 %%%-------------------------------------------------------------------
-parse(L) when is_list(L) ->
+-spec parse(binary()) -> {error, any()} | {ok, eldap:filter()}.
+
+parse(L) ->
     parse(L, []).
 
 %%%-------------------------------------------------------------------
@@ -80,8 +79,12 @@ parse(L) when is_list(L) ->
 %%%                              "jid",
 %%%                              "xramtsov@gmail.com"}}]}}
 %%%-------------------------------------------------------------------
-parse(L, SList) when is_list(L), is_list(SList) ->
-    case catch eldap_filter_yecc:parse(scan(L, SList)) of
+-spec parse(binary(), [{binary(), binary()} |
+                       {binary(), binary(), pos_integer()}]) ->
+                   {error, any()} | {ok, eldap:filter()}.
+
+parse(L, SList) ->
+    case catch eldap_filter_yecc:parse(scan(binary_to_list(L), SList)) of
         {'EXIT', _} = Err ->
             {error, Err};
 	{error, {_, _, Msg}} ->
@@ -95,13 +98,13 @@ parse(L, SList) when is_list(L), is_list(SList) ->
 %%====================================================================
 %% Internal functions
 %%====================================================================
--define(do_scan(L), scan(Rest, [], [{L, 1} | check(Buf, S) ++ Result], L, S)).
+-define(do_scan(L), scan(Rest, <<>>, [{L, 1} | check(Buf, S) ++ Result], L, S)).
 
 scan(L, SList) ->
-    scan(L, "", [], undefined, SList).
+    scan(L, <<"">>, [], undefined, SList).
 
 scan("=*)" ++ Rest, Buf, Result, '(', S) ->
-    scan(Rest, [], [{')', 1}, {'=*', 1} | check(Buf, S) ++ Result], ')', S);
+    scan(Rest, <<>>, [{')', 1}, {'=*', 1} | check(Buf, S) ++ Result], ')', S);
 scan(":dn" ++ Rest, Buf, Result, '(', S) -> ?do_scan(':dn');
 scan(":=" ++ Rest, Buf, Result, '(', S) -> ?do_scan(':=');
 scan(":=" ++ Rest, Buf, Result, ':dn', S) -> ?do_scan(':=');
@@ -112,35 +115,35 @@ scan("<=" ++ Rest, Buf, Result, '(', S) -> ?do_scan('<=');
 scan("="  ++ Rest, Buf, Result, '(', S) -> ?do_scan('=');
 scan(":"  ++ Rest, Buf, Result, '(', S) -> ?do_scan(':');
 scan(":"  ++ Rest, Buf, Result, ':dn', S) -> ?do_scan(':');
-scan("&"  ++ Rest, Buf, Result, '(', S) when Buf=="" -> ?do_scan('&');
-scan("|"  ++ Rest, Buf, Result, '(', S) when Buf=="" -> ?do_scan('|');
-scan("!"  ++ Rest, Buf, Result, '(', S) when Buf=="" -> ?do_scan('!');
+scan("&"  ++ Rest, Buf, Result, '(', S) when Buf==<<"">> -> ?do_scan('&');
+scan("|"  ++ Rest, Buf, Result, '(', S) when Buf==<<"">> -> ?do_scan('|');
+scan("!"  ++ Rest, Buf, Result, '(', S) when Buf==<<"">> -> ?do_scan('!');
 scan("*"  ++ Rest, Buf, Result, '*', S) -> ?do_scan('*');
 scan("*"  ++ Rest, Buf, Result, '=', S) -> ?do_scan('*');
 scan("("  ++ Rest, Buf, Result, _, S) -> ?do_scan('(');
 scan(")"  ++ Rest, Buf, Result, _, S) -> ?do_scan(')');
 scan([Letter | Rest], Buf, Result, PreviosAtom, S) ->
-    scan(Rest, [Letter|Buf], Result, PreviosAtom, S);
+    scan(Rest, <<Buf/binary, Letter>>, Result, PreviosAtom, S);
 scan([], Buf, Result, _, S) ->
     lists:reverse(check(Buf, S) ++ Result).
 
-check([], _) ->
+check(<<>>, _) ->
     [];
 check(Buf, S) ->
-    [{str, 1, do_sub(lists:reverse(Buf), S)}].
+    [{str, 1, binary_to_list(do_sub(Buf, S))}].
 
 -define(MAX_RECURSION, 100).
 
+-spec do_sub(binary(), [{binary(), binary()} |
+                        {binary(), binary(), pos_integer()}]) -> binary().
+
 do_sub(S, []) ->
     S;
-
-do_sub([], _) ->
-    [];
-
+do_sub(<<>>, _) ->
+    <<>>;
 do_sub(S, [{RegExp, New} | T]) ->
     Result = do_sub(S, {RegExp, replace_amps(New)}, 1),
     do_sub(Result, T);
-
 do_sub(S, [{RegExp, New, Times} | T]) ->
     Result = do_sub(S, {RegExp, replace_amps(New), Times}, 1),
     do_sub(Result, T).
@@ -178,8 +181,10 @@ do_sub(S, {RegExp, New, Times}, Iter) ->
             erlang:error(bad_regexp)
     end.
 
-replace_amps(String) ->
-    lists:flatmap(
-      fun($&) -> "\\&";
-	 (Chr) -> [Chr]
-      end, String).
+replace_amps(Bin) ->
+    list_to_binary(
+      lists:flatmap(
+        fun($&) -> "\\&";
+           ($\\) -> "\\\\";
+           (Chr) -> [Chr]
+        end, binary_to_list(Bin))).

src/eldap/eldap_filter_yecc.yrl

@@ -67,5 +67,5 @@ final(Value)                -> {final, Value}.
 'any'(Token, Value)         -> [Token, {any, Value}].
 xattr(Value)                -> {type, Value}.
 matchingrule(Value)         -> {matchingRule, Value}.
-value_of(Token)             -> element(3, Token).
+value_of(Token)             -> iolist_to_binary(element(3, Token)).
 flatten(List)               -> lists:flatten(List).

src/eldap/eldap_pool.erl

@@ -5,7 +5,7 @@
 %%% Created : 12 Nov 2006 by Evgeniy Khramtsov <xram@jabber.ru>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,27 +25,15 @@
 %%%-------------------------------------------------------------------
 
 -module(eldap_pool).
+
 -author('xram@jabber.ru').
 
 %% API
--export([
-	 start_link/7,
-	 bind/3,
-	 search/2,
-	 modify_passwd/3
-	]).
+-export([start_link/7, bind/3, search/2,
+	 modify_passwd/3]).
 
 -include("ejabberd.hrl").
 
--ifdef(SSL40).
--define(PG2, pg2).
--else.
--define(PG2, pg2_backport).
--endif.
-
-%%====================================================================
-%% API
-%%====================================================================
 bind(PoolName, DN, Passwd) ->
     do_request(PoolName, {bind, [DN, Passwd]}).
 
@@ -55,40 +43,38 @@ search(PoolName, Opts) ->
 modify_passwd(PoolName, DN, Passwd) ->
     do_request(PoolName, {modify_passwd, [DN, Passwd]}).
 
-start_link(Name, Hosts, Backups, Port, Rootdn, Passwd, Opts) ->
+start_link(Name, Hosts, Backups, Port, Rootdn, Passwd,
+	   Opts) ->
     PoolName = make_id(Name),
-    ?PG2:create(PoolName),
-    lists:foreach(
-      fun(Host) ->
-	      ID = erlang:ref_to_list(make_ref()),
-	      case catch eldap:start_link(ID, [Host|Backups], Port,
-					  Rootdn, Passwd, Opts) of
-		  {ok, Pid} ->
-		      ?PG2:join(PoolName, Pid);
-		  _ ->
-		      error
-	      end
-      end, Hosts).
+    pg2:create(PoolName),
+    lists:foreach(fun (Host) ->
+			  ID = list_to_binary(erlang:ref_to_list(make_ref())),
+			  case catch eldap:start_link(ID, [Host | Backups],
+						      Port, Rootdn, Passwd,
+						      Opts)
+			      of
+			    {ok, Pid} -> pg2:join(PoolName, Pid);
+			    Err ->
+                                  ?INFO_MSG("Err = ~p", [Err]),
+                                  error
+			  end
+		  end,
+		  Hosts).
 
-%%====================================================================
-%% Internal functions
-%%====================================================================
 do_request(Name, {F, Args}) ->
-    case ?PG2:get_closest_pid(make_id(Name)) of
-	Pid when is_pid(Pid) ->
-	    case catch apply(eldap, F, [Pid | Args]) of
-		{'EXIT', {timeout, _}} ->
-		    ?ERROR_MSG("LDAP request failed: timed out", []);
-		{'EXIT', Reason} ->
-		    ?ERROR_MSG("LDAP request failed: eldap:~p(~p)~nReason: ~p",
-			       [F, Args, Reason]),
-		    {error, Reason};
-		Reply ->
-		    Reply
-	    end;
-	Err ->
-	    Err
+    case pg2:get_closest_pid(make_id(Name)) of
+      Pid when is_pid(Pid) ->
+	  case catch apply(eldap, F, [Pid | Args]) of
+	    {'EXIT', {timeout, _}} ->
+		?ERROR_MSG("LDAP request failed: timed out", []);
+	    {'EXIT', Reason} ->
+		?ERROR_MSG("LDAP request failed: eldap:~p(~p)~nReason: ~p",
+			   [F, Args, Reason]),
+		{error, Reason};
+	    Reply -> Reply
+	  end;
+      Err -> Err
     end.
 
 make_id(Name) ->
-    list_to_atom("eldap_pool_" ++ Name).
+    jlib:binary_to_atom(<<"eldap_pool_", Name/binary>>).

src/eldap/eldap_utils.erl

@@ -5,7 +5,7 @@
 %%% Created : 12 Oct 2006 by Mickael Remond <mremond@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -30,15 +30,18 @@
 -export([generate_subfilter/1,
 	 find_ldap_attrs/2,
 	 get_ldap_attr/2,
-	 usort_attrs/1,
 	 get_user_part/2,
 	 make_filter/2,
 	 get_state/2,
 	 case_insensitive_match/2,
-         check_filter/1,
+         get_opt/3,
+         get_opt/4,
+         get_config/2,
+         decode_octet_string/3,
 	 uids_domain_subst/2]).
 
 -include("ejabberd.hrl").
+-include("eldap.hrl").
 
 %% Generate an 'or' LDAP query on one or several attributes
 %% If there is only one attribute
@@ -46,27 +49,33 @@ generate_subfilter([UID]) ->
     subfilter(UID);
 %% If there is several attributes
 generate_subfilter(UIDs) ->
-    "(|" ++ [subfilter(UID) || UID <- UIDs] ++ ")".
+    iolist_to_binary(["(|", [subfilter(UID) || UID <- UIDs], ")"]).
 %% Subfilter for a single attribute
+
 subfilter({UIDAttr, UIDAttrFormat}) ->
-    "(" ++ UIDAttr ++ "=" ++ UIDAttrFormat ++ ")";
-%% The default UiDAttrFormat is %u
+    <<$(, UIDAttr/binary, $=, UIDAttrFormat/binary, $)>>;
+%% The default UiDAttrFormat is <<"%u">>
 subfilter({UIDAttr}) ->
-    "(" ++ UIDAttr ++ "=" ++ "%u)".
+    <<$(, UIDAttr/binary, $=, "%u)">>.
 
 %% Not tail-recursive, but it is not very terribly.
 %% It stops finding on the first not empty value.
+-spec find_ldap_attrs([{binary()} | {binary(), binary()}],
+                      [{binary(), [binary()]}]) -> <<>> | {binary(), binary()}.
+
 find_ldap_attrs([{Attr} | Rest], Attributes) ->
-    find_ldap_attrs([{Attr, "%u"} | Rest], Attributes);
+    find_ldap_attrs([{Attr, <<"%u">>} | Rest], Attributes);
 find_ldap_attrs([{Attr, Format} | Rest], Attributes) ->
     case get_ldap_attr(Attr, Attributes) of
-	Value when is_list(Value), Value /= "" ->
+	Value when is_binary(Value), Value /= <<>> ->
 	    {Value, Format};
 	_ ->
 	    find_ldap_attrs(Rest, Attributes)
     end;
 find_ldap_attrs([], _) ->
-    "".
+    <<>>.
+
+-spec get_ldap_attr(binary(), [{binary(), [binary()]}]) -> binary().
 
 get_ldap_attr(LDAPAttr, Attributes) ->
     Res = lists:filter(
@@ -75,31 +84,26 @@ get_ldap_attr(LDAPAttr, Attributes) ->
 	    end, Attributes),
     case Res of
 	[{_, [Value|_]}] -> Value;
-	_ -> ""
+	_ -> <<>>
     end.
 
-
-usort_attrs(Attrs) when is_list(Attrs) ->
-    lists:usort(Attrs);
-usort_attrs(_) ->
-    [].
+-spec get_user_part(binary(), binary()) -> {ok, binary()} | {error, badmatch}.
 
 get_user_part(String, Pattern) ->
     F = fun(S, P) ->
-		First = string:str(P, "%u"),
-		TailLength = length(P) - (First+1),
-		string:sub_string(S, First, length(S) - TailLength)
+		First = str:str(P, <<"%u">>),
+		TailLength = byte_size(P) - (First+1),
+		str:sub_string(S, First, byte_size(S) - TailLength)
 	end,
     case catch F(String, Pattern) of
 	{'EXIT', _} ->
 	    {error, badmatch};
 	Result ->
-            case catch ejabberd_regexp:replace(Pattern, "%u", Result) of
+            case catch ejabberd_regexp:replace(Pattern, <<"%u">>, Result) of
                 {'EXIT', _} ->
                     {error, badmatch};
 		StringRes ->
-                    case (string:to_lower(StringRes) ==
-                              string:to_lower(String)) of
+                    case case_insensitive_match(StringRes, String) of
                         true ->
                             {ok, Result};
                         false ->
@@ -108,20 +112,25 @@ get_user_part(String, Pattern) ->
             end
     end.
 
+-spec make_filter([{binary(), [binary()]}], [{binary(), binary()}]) -> any().
+
 make_filter(Data, UIDs) ->
-    NewUIDs = [{U, eldap_filter:do_sub(UF, [{"%u", "*%u*", 1}])} || {U, UF} <- UIDs],
+    NewUIDs = [{U, eldap_filter:do_sub(
+                     UF, [{<<"%u">>, <<"*%u*">>, 1}])} || {U, UF} <- UIDs],
     Filter = lists:flatmap(
 	       fun({Name, [Value | _]}) ->
 		       case Name of
-			   "%u" when Value /= "" ->
+			   <<"%u">> when Value /= <<"">> ->
 			       case eldap_filter:parse(
-				      lists:flatten(generate_subfilter(NewUIDs)),
-				               [{"%u", Value}]) of
+				      generate_subfilter(NewUIDs),
+                                      [{<<"%u">>, Value}]) of
 				   {ok, F} -> [F];
 				   _ -> []
 			       end;
-			   _ when Value /= "" ->
-			       [eldap:substrings(Name, [{any, Value}])];
+			   _ when Value /= <<"">> ->
+			       [eldap:substrings(
+                                  Name,
+                                  [{any, Value}])];
 			   _ ->
 			       []
 		       end
@@ -133,9 +142,11 @@ make_filter(Data, UIDs) ->
 	    eldap:'and'(Filter)
     end.
 
+-spec case_insensitive_match(binary(), binary()) -> boolean().
+
 case_insensitive_match(X, Y) ->
-    X1 = stringprep:tolower(X),
-    Y1 = stringprep:tolower(Y),
+    X1 = str:to_lower(X),
+    Y1 = str:to_lower(Y),
     if
 	X1 == Y1 -> true;
 	true -> false
@@ -149,22 +160,197 @@ get_state(Server, Module) ->
 %% we look from alias domain (%d) and make the substitution
 %% with the actual host domain
 %% This help when you need to configure many virtual domains.
+-spec uids_domain_subst(binary(), [{binary(), binary()}]) -> 
+                               [{binary(), binary()}].
+
 uids_domain_subst(Host, UIDs) ->
     lists:map(fun({U,V}) ->
-                      {U, eldap_filter:do_sub(V,[{"%d", Host}])};
+                      {U, eldap_filter:do_sub(V,[{<<"%d">>, Host}])};
                   (A) -> A 
               end,
               UIDs).
 
-check_filter(undefined) ->
-    ok;
-check_filter(Filter) ->
-    case eldap_filter:parse(Filter) of
-        {ok, _} ->
-            ok;
-        Err ->
-            ?ERROR_MSG("failed to parse LDAP filter:~n"
-                       "** Filter: ~p~n"
-                       "** Reason: ~p",
-                       [Filter, Err])
+-spec get_opt({atom(), binary()}, list(), fun()) -> any().
+
+get_opt({Key, Host}, Opts, F) ->
+    get_opt({Key, Host}, Opts, F, undefined).
+
+-spec get_opt({atom(), binary()}, list(), fun(), any()) -> any().
+
+get_opt({Key, Host}, Opts, F, Default) ->
+    case gen_mod:get_opt(Key, Opts, F, undefined) of
+        undefined ->
+            ejabberd_config:get_local_option(
+              {Key, Host}, F, Default);
+        Val ->
+            Val
     end.
+
+-spec get_config(binary(), list()) -> eldap_config().
+
+get_config(Host, Opts) ->
+    Servers = get_opt({ldap_servers, Host}, Opts,
+                      fun(L) ->
+                              [iolist_to_binary(H) || H <- L]
+                      end, [<<"localhost">>]),
+    Backups = get_opt({ldap_backups, Host}, Opts,
+                      fun(L) ->
+                              [iolist_to_binary(H) || H <- L]
+                      end, []),
+    Encrypt = get_opt({ldap_encrypt, Host}, Opts,
+                      fun(tls) -> tls;
+                         (starttls) -> starttls;
+                         (none) -> none
+                      end, none),
+    TLSVerify = get_opt({ldap_tls_verify, Host}, Opts,
+                        fun(hard) -> hard;
+                           (soft) -> soft;
+                           (false) -> false
+                        end, false),
+    TLSCFile = get_opt({ldap_tls_certfile, Host}, Opts,
+                       fun iolist_to_binary/1),
+    TLSCAFile = get_opt({ldap_tls_cacertfile, Host}, Opts,
+                        fun iolist_to_binary/1),
+    TLSDepth = get_opt({ldap_tls_depth, Host}, Opts,
+                       fun(I) when is_integer(I), I>=0 -> I end),
+    Port = get_opt({ldap_port, Host}, Opts,
+                   fun(I) when is_integer(I), I>0 -> I end,
+                   case Encrypt of
+                       tls -> ?LDAPS_PORT;
+                       starttls -> ?LDAP_PORT;
+                       _ -> ?LDAP_PORT
+                   end),
+    RootDN = get_opt({ldap_rootdn, Host}, Opts,
+                     fun iolist_to_binary/1,
+                     <<"">>),
+    Password = get_opt({ldap_password, Host}, Opts,
+                 fun iolist_to_binary/1,
+                 <<"">>),
+    Base = get_opt({ldap_base, Host}, Opts,
+                   fun iolist_to_binary/1,
+                   <<"">>),
+    DerefAliases = get_opt({deref_aliases, Host}, Opts,
+                           fun(never) -> never;
+                              (searching) -> searching;
+                              (finding) -> finding;
+                              (always) -> always
+                           end, never),
+    #eldap_config{servers = Servers,
+                  backups = Backups,
+                  tls_options = [{encrypt, Encrypt},
+                                 {tls_verify, TLSVerify},
+                                 {tls_certfile, TLSCFile},
+                                 {tls_cacertfile, TLSCAFile},
+                                 {tls_depth, TLSDepth}],
+                  port = Port,
+                  dn = RootDN,
+                  password = Password,
+                  base = Base,
+                  deref_aliases = DerefAliases}.
+
+%%---------------------------------------- 
+%% Borrowed from asn1rt_ber_bin_v2.erl
+%%----------------------------------------
+
+%%% The tag-number for universal types
+-define(N_BOOLEAN, 1). 
+-define(N_INTEGER, 2). 
+-define(N_BIT_STRING, 3).
+-define(N_OCTET_STRING, 4).
+-define(N_NULL, 5). 
+-define(N_OBJECT_IDENTIFIER, 6). 
+-define(N_OBJECT_DESCRIPTOR, 7). 
+-define(N_EXTERNAL, 8). 
+-define(N_REAL, 9). 
+-define(N_ENUMERATED, 10). 
+-define(N_EMBEDDED_PDV, 11). 
+-define(N_SEQUENCE, 16). 
+-define(N_SET, 17). 
+-define(N_NumericString, 18).
+-define(N_PrintableString, 19).
+-define(N_TeletexString, 20).
+-define(N_VideotexString, 21).
+-define(N_IA5String, 22).
+-define(N_UTCTime, 23). 
+-define(N_GeneralizedTime, 24). 
+-define(N_GraphicString, 25).
+-define(N_VisibleString, 26).
+-define(N_GeneralString, 27).
+-define(N_UniversalString, 28).
+-define(N_BMPString, 30).
+
+decode_octet_string(Buffer, Range, Tags) -> 
+%    NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_OCTET_STRING}),
+    decode_restricted_string(Buffer, Range, Tags).
+
+decode_restricted_string(Tlv, Range, TagsIn) ->
+    Val = match_tags(Tlv, TagsIn),
+    Val2 = 
+	case Val of
+	    PartList = [_H|_T] -> % constructed val
+		collect_parts(PartList);
+	    Bin ->
+                Bin
+	end,
+    check_and_convert_restricted_string(Val2, Range).
+
+check_and_convert_restricted_string(Val, Range) ->
+    {StrLen,NewVal} = if is_binary(Val) ->
+			      {size(Val), Val};
+                         true ->
+			      {length(Val), list_to_binary(Val)}
+		      end,
+    case Range of
+	[] -> % No length constraint
+	    NewVal;
+	{Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint
+	    NewVal;
+	{{Lb,_Ub},[]} when StrLen >= Lb ->
+	    NewVal;
+	{{Lb,_Ub},_Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min ->
+	    NewVal;
+	{{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; 
+				   StrLen =< Ub2, StrLen >= Lb2 ->
+	    NewVal;
+	StrLen -> % fixed length constraint
+	    NewVal;
+	{_,_} -> 
+	    exit({error,{asn1,{length,Range,Val}}});
+	_Len when is_integer(_Len) ->
+	    exit({error,{asn1,{length,Range,Val}}});
+	_ -> % some strange constraint that we don't support yet
+	    NewVal
+    end.
+
+%%---------------------------------------- 
+%% Decode the in buffer to bits 
+%%---------------------------------------- 
+match_tags({T,V},[T]) ->
+    V;
+match_tags({T,V}, [T|Tt]) ->
+    match_tags(V,Tt);
+match_tags([{T,V}],[T|Tt]) ->
+    match_tags(V, Tt);
+match_tags(Vlist = [{T,_V}|_], [T]) ->
+    Vlist;
+match_tags(Tlv, []) ->
+    Tlv;
+match_tags({Tag,_V},[T|_Tt]) ->
+    {error,{asn1,{wrong_tag,{Tag,T}}}}.
+
+collect_parts(TlvList) ->
+    collect_parts(TlvList,[]).
+
+collect_parts([{_,L}|Rest],Acc) when is_list(L) ->
+    collect_parts(Rest,[collect_parts(L)|Acc]);
+collect_parts([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],_Acc) ->
+    collect_parts_bit(Rest,[Bits],Unused);
+collect_parts([{_T,V}|Rest],Acc) ->
+    collect_parts(Rest,[V|Acc]);
+collect_parts([],Acc) ->
+    list_to_binary(lists:reverse(Acc)).
+
+collect_parts_bit([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],Acc,Uacc) ->    
+    collect_parts_bit(Rest,[Bits|Acc],Unused+Uacc);
+collect_parts_bit([],Acc,Uacc) ->
+    list_to_binary([Uacc|lists:reverse(Acc)]).

src/expat_erl.c

@@ -1,5 +1,5 @@
 /*
- * ejabberd, Copyright (C) 2002-2012   ProcessOne
+ * ejabberd, Copyright (C) 2002-2013   ProcessOne
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License as
@@ -70,13 +70,13 @@ void encode_name(const XML_Char *name)
       memcpy(buf, prefix_start+1, prefix_len);
       memcpy(buf+prefix_len, name_start, name_len);
       buf[prefix_len] = ':';
-      ei_x_encode_string_len(&event_buf, buf, buf_len);
+      ei_x_encode_binary(&event_buf, buf, buf_len);
       driver_free(buf);
     } else {
-      ei_x_encode_string(&event_buf, name_start+1);
+       ei_x_encode_binary(&event_buf, name_start+1, strlen(name_start+1));
     };
   } else {
-    ei_x_encode_string(&event_buf, name);
+     ei_x_encode_binary(&event_buf, name, strlen(name));
   }
 }
 
@@ -105,7 +105,7 @@ void *erlXML_StartElementHandler(expat_data *d,
       {
 	 ei_x_encode_tuple_header(&event_buf, 2);
 	 encode_name(atts[i]);
-	 ei_x_encode_string(&event_buf, atts[i+1]);
+	 ei_x_encode_binary(&event_buf, atts[i+1], strlen(atts[i+1]));
       }
    }
 
@@ -159,12 +159,12 @@ void *erlXML_StartNamespaceDeclHandler(expat_data *d,
     buf = driver_alloc(7 + prefix_len);
     strcpy(buf, "xmlns:");
     strcpy(buf+6, prefix);
-    ei_x_encode_string(&xmlns_buf, buf);
+    ei_x_encode_binary(&xmlns_buf, buf, strlen(buf));
     driver_free(buf);
   } else {
-    ei_x_encode_string(&xmlns_buf, "xmlns");
+     ei_x_encode_binary(&xmlns_buf, "xmlns", strlen("xmlns"));
   };
-  ei_x_encode_string(&xmlns_buf, uri);
+  ei_x_encode_binary(&xmlns_buf, uri, strlen(uri));
 
   return NULL;
 }
@@ -217,6 +217,35 @@ static ErlDrvSSizeT expat_erl_control(ErlDrvData drv_data,
       case PARSE_FINAL_COMMAND:
 	 ei_x_new_with_version(&event_buf);
 	 ei_x_new(&xmlns_buf);
+#ifdef ENABLE_FLASH_HACK
+        /* Flash hack - Flash clients send a null byte after the stanza.  Remove that... */
+        {
+           int i;
+           int found_null = 0;
+
+           /* Maybe the Flash client sent many stanzas in one packet.
+              If so, there is a null byte between every stanza. */
+           for (i = 0; i < len; i++) {
+              if (buf[i] == '\0') {
+                 buf[i] = ' ';
+                 found_null = 1;
+              }
+           }
+
+           /* And also remove the closing slash if this is a
+              flash:stream element.  Assume that flash:stream is the
+              last element in the packet, and entirely contained in
+              it.  This requires that a null byte has been found. */
+           if (found_null && strstr(buf, "<flash:stream"))
+              /* buf[len - 1] is an erased null byte.
+                 buf[len - 2] is >
+                 buf[len - 3] is / (maybe)
+              */
+              if (buf[len - 3] == '/')
+                 buf[len - 3] = ' ';
+        }
+#endif /* ENABLE_FLASH_HACK */
+
 	 res = XML_Parse(d->parser, buf, len, command == PARSE_FINAL_COMMAND);
 
 	 if(!res)
@@ -229,7 +258,7 @@ static ErlDrvSSizeT expat_erl_control(ErlDrvData drv_data,
 	    ei_x_encode_long(&event_buf, XML_ERROR);
 	    ei_x_encode_tuple_header(&event_buf, 2);
 	    ei_x_encode_long(&event_buf, errcode);
-	    ei_x_encode_string(&event_buf, errstring);
+	    ei_x_encode_binary(&event_buf, errstring, strlen(errstring));
 	 }
 
 	 ei_x_encode_empty_list(&event_buf);

src/extauth.erl

@@ -5,7 +5,7 @@
 %%% Created : 30 Jul 2004 by Leif Johansson <leifj@it.su.se>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,30 +25,24 @@
 %%%----------------------------------------------------------------------
 
 -module(extauth).
+
 -author('leifj@it.su.se').
 
--export([start/2,
-	 stop/1,
-	 init/2,
-	 check_password/3,
-	 set_password/3,
-	 try_register/3,
-	 remove_user/2,
-	 remove_user/3,
-	 is_user_exists/2]).
+-export([start/2, stop/1, init/2, check_password/3,
+	 set_password/3, try_register/3, remove_user/2,
+	 remove_user/3, is_user_exists/2]).
 
 -include("ejabberd.hrl").
 
--define(INIT_TIMEOUT, 60000). % Timeout is in milliseconds: 60 seconds == 60000
--define(CALL_TIMEOUT, 10000). % Timeout is in milliseconds: 10 seconds == 10000
+-define(INIT_TIMEOUT, 60000).
+
+-define(CALL_TIMEOUT, 10000).
 
 start(Host, ExtPrg) ->
-    lists:foreach(
-	fun(This) ->
-	    start_instance(get_process_name(Host, This), ExtPrg)
-	end,
-	lists:seq(0, get_instances(Host)-1)
-    ).
+    lists:foreach(fun (This) ->
+			  start_instance(get_process_name(Host, This), ExtPrg)
+		  end,
+		  lists:seq(0, get_instances(Host) - 1)).
 
 start_instance(ProcessName, ExtPrg) ->
     spawn(?MODULE, init, [ProcessName, ExtPrg]).
@@ -59,20 +53,20 @@ restart_instance(ProcessName, ExtPrg) ->
 
 init(ProcessName, ExtPrg) ->
     register(ProcessName, self()),
-    process_flag(trap_exit,true),
-    Port = open_port({spawn, ExtPrg}, [{packet,2}]),
+    process_flag(trap_exit, true),
+    Port = open_port({spawn, ExtPrg}, [{packet, 2}]),
     loop(Port, ?INIT_TIMEOUT, ProcessName, ExtPrg).
 
 stop(Host) ->
-    lists:foreach(
-	fun(This) ->
-	    get_process_name(Host, This) ! stop
-	end,
-	lists:seq(0, get_instances(Host)-1)
-    ).
+    lists:foreach(fun (This) ->
+			  get_process_name(Host, This) ! stop
+		  end,
+		  lists:seq(0, get_instances(Host) - 1)).
 
 get_process_name(Host, Integer) ->
-    gen_mod:get_module_proc(lists:append([Host, integer_to_list(Integer)]), eauth).
+    gen_mod:get_module_proc(iolist_to_binary([Host,
+                                              integer_to_list(Integer)]),
+			    eauth).
 
 check_password(User, Server, Password) ->
     call_port(Server, ["auth", User, Server, Password]).
@@ -84,90 +78,88 @@ set_password(User, Server, Password) ->
     call_port(Server, ["setpass", User, Server, Password]).
 
 try_register(User, Server, Password) ->
-    case call_port(Server, ["tryregister", User, Server, Password]) of
-	true -> {atomic, ok};
-	false -> {error, not_allowed}
+    case call_port(Server,
+		   ["tryregister", User, Server, Password])
+	of
+      true -> {atomic, ok};
+      false -> {error, not_allowed}
     end.
 
 remove_user(User, Server) ->
     call_port(Server, ["removeuser", User, Server]).
 
 remove_user(User, Server, Password) ->
-    call_port(Server, ["removeuser3", User, Server, Password]).
+    call_port(Server,
+	      ["removeuser3", User, Server, Password]).
 
 call_port(Server, Msg) ->
     LServer = jlib:nameprep(Server),
-    ProcessName = get_process_name(LServer, random_instance(get_instances(LServer))),
+    ProcessName = get_process_name(LServer,
+				   random_instance(get_instances(LServer))),
     ProcessName ! {call, self(), Msg},
-    receive
-	{eauth,Result} ->
-	    Result
-    end.
+    receive {eauth, Result} -> Result end.
 
 random_instance(MaxNum) ->
-    {A1,A2,A3} = now(),
+    {A1, A2, A3} = now(),
     random:seed(A1, A2, A3),
     random:uniform(MaxNum) - 1.
 
 get_instances(Server) ->
-    case ejabberd_config:get_local_option({extauth_instances, Server}) of
-	Num when is_integer(Num) -> Num;
-	_ -> 1
-    end.
+    ejabberd_config:get_local_option(
+      {extauth_instances, Server},
+      fun(V) when is_integer(V), V > 0 ->
+              V
+      end, 1).
 
 loop(Port, Timeout, ProcessName, ExtPrg) ->
     receive
-	{call, Caller, Msg} ->
-	    port_command(Port, encode(Msg)),
-	    receive
-		{Port, {data, Data}} ->
-                    ?DEBUG("extauth call '~p' received data response:~n~p", [Msg, Data]),
-		    Caller ! {eauth, decode(Data)},
-		    loop(Port, ?CALL_TIMEOUT, ProcessName, ExtPrg);
-		{Port, Other} ->
-                    ?ERROR_MSG("extauth call '~p' received strange response:~n~p", [Msg, Other]),
-		    Caller ! {eauth, false},
-		    loop(Port, ?CALL_TIMEOUT, ProcessName, ExtPrg)
-            after
-                Timeout ->
-                    ?ERROR_MSG("extauth call '~p' didn't receive response", [Msg]),
-		    Caller ! {eauth, false},
-		    Pid = restart_instance(ProcessName, ExtPrg),
-		    flush_buffer_and_forward_messages(Pid),
-		    exit(port_terminated)
-	    end;
-	stop ->
-	    Port ! {self(), close},
-	    receive
-		{Port, closed} ->
-		    exit(normal)
-	    end;
-	{'EXIT', Port, Reason} ->
-	    ?CRITICAL_MSG("extauth script has exitted abruptly with reason '~p'", [Reason]),
-	    Pid = restart_instance(ProcessName, ExtPrg),
-	    flush_buffer_and_forward_messages(Pid),
-	    exit(port_terminated)
+      {call, Caller, Msg} ->
+	  port_command(Port, encode(Msg)),
+	  receive
+	    {Port, {data, Data}} ->
+		?DEBUG("extauth call '~p' received data response:~n~p",
+		       [Msg, Data]),
+		Caller ! {eauth, decode(Data)},
+		loop(Port, ?CALL_TIMEOUT, ProcessName, ExtPrg);
+	    {Port, Other} ->
+		?ERROR_MSG("extauth call '~p' received strange response:~n~p",
+			   [Msg, Other]),
+		Caller ! {eauth, false},
+		loop(Port, ?CALL_TIMEOUT, ProcessName, ExtPrg)
+	    after Timeout ->
+		      ?ERROR_MSG("extauth call '~p' didn't receive response",
+				 [Msg]),
+		      Caller ! {eauth, false},
+		      Pid = restart_instance(ProcessName, ExtPrg),
+		      flush_buffer_and_forward_messages(Pid),
+		      exit(port_terminated)
+	  end;
+      stop ->
+	  Port ! {self(), close},
+	  receive {Port, closed} -> exit(normal) end;
+      {'EXIT', Port, Reason} ->
+	  ?CRITICAL_MSG("extauth script has exitted abruptly "
+			"with reason '~p'",
+			[Reason]),
+	  Pid = restart_instance(ProcessName, ExtPrg),
+	  flush_buffer_and_forward_messages(Pid),
+	  exit(port_terminated)
     end.
 
 flush_buffer_and_forward_messages(Pid) ->
     receive
-	Message ->
-	    Pid ! Message,
-	    flush_buffer_and_forward_messages(Pid)
-    after 0 ->
-	    true
+      Message ->
+	  Pid ! Message, flush_buffer_and_forward_messages(Pid)
+      after 0 -> true
     end.
 
 join(List, Sep) ->
-    lists:foldl(fun(A, "") -> A;
-		   (A, Acc) -> Acc ++ Sep ++ A
-		end, "", List).
+    lists:foldl(fun (A, "") -> A;
+		    (A, Acc) -> Acc ++ Sep ++ A
+		end,
+		"", List).
 
-encode(L) ->
-    join(L,":").
-
-decode([0,0]) ->
-    false;
-decode([0,1]) ->
-    true.
+encode(L) -> join(L, ":").
 
+decode([0, 0]) -> false;
+decode([0, 1]) -> true.

src/gen_iq_handler.erl

@@ -5,7 +5,7 @@
 %%% Created : 22 Jan 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,27 +25,30 @@
 %%%----------------------------------------------------------------------
 
 -module(gen_iq_handler).
+
 -author('alexey@process-one.net').
 
 -behaviour(gen_server).
 
 %% API
--export([start_link/3,
-	 add_iq_handler/6,
-	 remove_iq_handler/3,
-	 stop_iq_handler/3,
-	 handle/7,
-	 process_iq/6]).
+-export([start_link/5, add_iq_handler/6,
+	 remove_iq_handler/3, stop_iq_handler/3, handle/7,
+	 process_iq/6, check_type/1]).
 
 %% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
-	 terminate/2, code_change/3]).
+-export([init/1, handle_call/3, handle_cast/2,
+	 handle_info/2, terminate/2, code_change/3]).
 
 -include("ejabberd.hrl").
+-include("jlib.hrl").
 
--record(state, {host,
-		module,
-		function}).
+-record(state, {host = <<"">> :: binary(),
+                module :: atom(),
+                function :: atom()}).
+
+-type component() :: ejabberd_sm | ejabberd_local.
+-type type() :: no_queue | one_queue | {queues, pos_integer()} | parallel.
+-type opts() :: no_queue | {one_queue, pid()} | {queues, [pid()]} | parallel.
 
 %%====================================================================
 %% API
@@ -54,148 +57,129 @@
 %% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
 %% Description: Starts the server
 %%--------------------------------------------------------------------
-start_link(Host, Module, Function) ->
-    gen_server:start_link(?MODULE, [Host, Module, Function], []).
+start_link(Component, Host, NS, Module, Function) ->
+    {ok, Pid} = gen_server:start_link(?MODULE, [Host, Module, Function], []),
+    Component:register_iq_handler(Host, NS, Module, Function, Pid),
+    {ok, Pid}.
 
-add_iq_handler(Component, Host, NS, Module, Function, Type) ->
+-spec add_iq_handler(component(), binary(), binary(),
+                     atom(), atom(), type()) -> any().
+
+add_iq_handler(Component, Host, NS, Module, Function,
+	       Type) ->
     case Type of
 	no_queue ->
 	    Component:register_iq_handler(Host, NS, Module, Function, no_queue);
 	one_queue ->
-	    {ok, Pid} = supervisor:start_child(ejabberd_iq_sup,
-					       [Host, Module, Function]),
-	    Component:register_iq_handler(Host, NS, Module, Function,
-					  {one_queue, Pid});
+            start_handler(Component, Host, NS, Module, Function);
 	{queues, N} ->
-	    Pids =
-		lists:map(
-		  fun(_) ->
-			  {ok, Pid} = supervisor:start_child(
-					ejabberd_iq_sup,
-					[Host, Module, Function]),
-			  Pid
-		  end, lists:seq(1, N)),
-	    Component:register_iq_handler(Host, NS, Module, Function,
-					  {queues, Pids});
+            lists:foreach(
+              fun(_) ->
+                      start_handler(Component, Host, NS, Module, Function)
+              end, lists:seq(1, N));
 	parallel ->
 	    Component:register_iq_handler(Host, NS, Module, Function, parallel)
     end.
 
+-spec remove_iq_handler(component(), binary(), binary()) -> any().
+
 remove_iq_handler(Component, Host, NS) ->
     Component:unregister_iq_handler(Host, NS).
 
+-spec stop_iq_handler(atom(), atom(), [pid()]) -> any().
+
 stop_iq_handler(_Module, _Function, Opts) ->
     case Opts of
-	{one_queue, Pid} ->
-	    gen_server:call(Pid, stop);
-	{queues, Pids} ->
-	    lists:foreach(fun(Pid) ->
-				  catch gen_server:call(Pid, stop)
-			  end, Pids);
+	[_|_] = Pids ->
+	    stop_handlers(Pids);
 	_ ->
 	    ok
     end.
 
+-spec handle(binary(), atom(), atom(), opts(), jid(), jid(), iq()) -> any().
+
 handle(Host, Module, Function, Opts, From, To, IQ) ->
     case Opts of
 	no_queue ->
 	    process_iq(Host, Module, Function, From, To, IQ);
-	{one_queue, Pid} ->
-	    Pid ! {process_iq, From, To, IQ};
-	{queues, Pids} ->
+        parallel ->
+	    spawn(?MODULE, process_iq, [Host, Module, Function, From, To, IQ]);
+	[_|_] = Pids ->
 	    Pid = lists:nth(erlang:phash(now(), length(Pids)), Pids),
 	    Pid ! {process_iq, From, To, IQ};
-	parallel ->
-	    spawn(?MODULE, process_iq, [Host, Module, Function, From, To, IQ]);
 	_ ->
+            ?ERROR_MSG("unexpected iqdisc options = ~p", [Opts]),
 	    todo
     end.
 
+-spec process_iq(binary(), atom(), atom(), jid(), jid(), iq()) -> any().
 
 process_iq(_Host, Module, Function, From, To, IQ) ->
     case catch Module:Function(From, To, IQ) of
-	{'EXIT', Reason} ->
-	    ?ERROR_MSG("~p", [Reason]);
-	ResIQ ->
-	    if
-		ResIQ /= ignore ->
-		    ejabberd_router:route(To, From,
-					  jlib:iq_to_xml(ResIQ));
-		true ->
-		    ok
-	    end
+      {'EXIT', Reason} -> ?ERROR_MSG("~p", [Reason]);
+      ResIQ ->
+	  if ResIQ /= ignore ->
+		 ejabberd_router:route(To, From, jlib:iq_to_xml(ResIQ));
+	     true -> ok
+	  end
     end.
 
+-spec check_type(type()) -> type().
+
+check_type(no_queue) -> no_queue;
+check_type(one_queue) -> one_queue;
+check_type({queues, N}) when is_integer(N), N>0 -> {queues, N};
+check_type(parallel) -> parallel.
+
+start_handler(Component, Host, NS, Module, Function) ->
+    Spec = {{?MODULE, make_ref()},
+            {?MODULE, start_link, [Component, Host, NS, Module, Function]},
+            permanent,
+            brutal_kill,
+            worker,
+            [?MODULE]},
+    {ok, Pid} = supervisor:start_child(ejabberd_iq_sup, Spec),
+    Pid.
+
+stop_handlers(Pids) ->
+    lists:foreach(
+      fun({Id, Pid, _, _}) ->
+              case lists:member(Pid, Pids) of
+                  true ->
+                      supervisor:terminate_child(ejabberd_iq_sup, Id),
+                      supervisor:delete_child(ejabberd_iq_sup, Id);
+                  false ->
+                      ok
+              end
+      end, supervisor:which_children(ejabberd_iq_sup)).
+
 %%====================================================================
 %% gen_server callbacks
 %%====================================================================
 
-%%--------------------------------------------------------------------
-%% Function: init(Args) -> {ok, State} |
-%%                         {ok, State, Timeout} |
-%%                         ignore               |
-%%                         {stop, Reason}
-%% Description: Initiates the server
-%%--------------------------------------------------------------------
 init([Host, Module, Function]) ->
-    {ok, #state{host = Host,
-		module = Module,
-		function = Function}}.
+    {ok,
+     #state{host = Host, module = Module,
+	    function = Function}}.
 
-%%--------------------------------------------------------------------
-%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
-%%                                      {reply, Reply, State, Timeout} |
-%%                                      {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, Reply, State} |
-%%                                      {stop, Reason, State}
-%% Description: Handling call messages
-%%--------------------------------------------------------------------
 handle_call(stop, _From, State) ->
-    Reply = ok,
-    {stop, normal, Reply, State}.
+    Reply = ok, {stop, normal, Reply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%%                                      {noreply, State, Timeout} |
-%%                                      {stop, Reason, State}
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
-handle_cast(_Msg, State) ->
-    {noreply, State}.
+handle_cast(_Msg, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%%                                       {noreply, State, Timeout} |
-%%                                       {stop, Reason, State}
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
 handle_info({process_iq, From, To, IQ},
-	    #state{host = Host,
-		   module = Module,
-		   function = Function} = State) ->
+	    #state{host = Host, module = Module,
+		   function = Function} =
+		State) ->
     process_iq(Host, Module, Function, From, To, IQ),
     {noreply, State};
-handle_info(_Info, State) ->
-    {noreply, State}.
+handle_info(_Info, State) -> {noreply, State}.
 
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> void()
-%% Description: This function is called by a gen_server when it is about to
-%% terminate. It should be the opposite of Module:init/1 and do any necessary
-%% cleaning up. When it returns, the gen_server terminates with Reason.
-%% The return value is ignored.
-%%--------------------------------------------------------------------
-terminate(_Reason, _State) ->
-    ok.
+terminate(_Reason, _State) -> ok.
 
-%%--------------------------------------------------------------------
-%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
-    {ok, State}.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
 
 %%--------------------------------------------------------------------
 %%% Internal functions
 %%--------------------------------------------------------------------
+

src/gen_mod.erl

@@ -1,11 +1,11 @@
 %%%----------------------------------------------------------------------
 %%% File    : gen_mod.erl
 %%% Author  : Alexey Shchepin <alexey@process-one.net>
-%%% Purpose : 
+%%% Purpose :
 %%% Created : 24 Jan 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,101 +25,98 @@
 %%%----------------------------------------------------------------------
 
 -module(gen_mod).
+
 -author('alexey@process-one.net').
 
--export([start/0,
-	 start_module/3,
-	 stop_module/2,
-	 stop_module_keep_config/2,
-	 get_opt/2,
-	 get_opt/3,
-	 get_opt_host/3,
-         db_type/1,
-         db_type/2,
-	 get_module_opt/4,
-	 get_module_opt_host/3,
-	 loaded_modules/1,
-	 loaded_modules_with_opts/1,
-	 get_hosts/2,
-	 get_module_proc/2,
-	 is_loaded/2]).
+-export([start/0, start_module/3, stop_module/2,
+	 stop_module_keep_config/2, get_opt/3, get_opt/4,
+	 get_opt_host/3, db_type/1, db_type/2, get_module_opt/5,
+	 get_module_opt_host/3, loaded_modules/1,
+	 loaded_modules_with_opts/1, get_hosts/2,
+	 get_module_proc/2, is_loaded/2]).
 
--export([behaviour_info/1]).
+%%-export([behaviour_info/1]).
 
 -include("ejabberd.hrl").
 
--record(ejabberd_module, {module_host, opts}).
+-record(ejabberd_module,
+        {module_host = {undefined, <<"">>} :: {atom(), binary()},
+         opts = [] :: opts() | '_' | '$2'}).
 
-behaviour_info(callbacks) ->
-    [{start, 2},
-     {stop, 1}];
-behaviour_info(_Other) ->
-    undefined.
+-type opts() :: [{atom(), any()}].
+-type db_type() :: odbc | mnesia | riak.
+
+-callback start(binary(), opts()) -> any().
+-callback stop(binary()) -> any().
+
+-export_type([opts/0]).
+-export_type([db_type/0]).
+
+%%behaviour_info(callbacks) -> [{start, 2}, {stop, 1}];
+%%behaviour_info(_Other) -> undefined.
 
 start() ->
-    ets:new(ejabberd_modules, [named_table,
-			       public,
-			       {keypos, #ejabberd_module.module_host}]),
+    ets:new(ejabberd_modules,
+	    [named_table, public,
+	     {keypos, #ejabberd_module.module_host}]),
     ok.
 
+-spec start_module(binary(), atom(), opts()) -> any().
 
 start_module(Host, Module, Opts) ->
     set_module_opts_mnesia(Host, Module, Opts),
     ets:insert(ejabberd_modules,
 	       #ejabberd_module{module_host = {Module, Host},
 				opts = Opts}),
-    try Module:start(Host, Opts)
-    catch Class:Reason ->
-	    del_module_mnesia(Host, Module),
-	    ets:delete(ejabberd_modules, {Module, Host}),
-	    ErrorText = io_lib:format("Problem starting the module ~p for host ~p ~n options: ~p~n ~p: ~p",
-		    [Module, Host, Opts, Class, Reason]),
-	    ?CRITICAL_MSG(ErrorText, []),
-	    case is_app_running(ejabberd) of
-		true ->
-		    erlang:raise(Class, Reason, erlang:get_stacktrace());
-		false ->
-		    ?CRITICAL_MSG("ejabberd initialization was aborted because a module start failed.", []),
-		    timer:sleep(3000),
-		    erlang:halt(string:substr(lists:flatten(ErrorText), 1, 199))
-	    end
+    try Module:start(Host, Opts) catch
+      Class:Reason ->
+	  del_module_mnesia(Host, Module),
+	  ets:delete(ejabberd_modules, {Module, Host}),
+	  ErrorText =
+	      io_lib:format("Problem starting the module ~p for host "
+			    "~p ~n options: ~p~n ~p: ~p~n~p",
+			    [Module, Host, Opts, Class, Reason,
+			     erlang:get_stacktrace()]),
+	  ?CRITICAL_MSG(ErrorText, []),
+	  case is_app_running(ejabberd) of
+	    true ->
+		erlang:raise(Class, Reason, erlang:get_stacktrace());
+	    false ->
+		?CRITICAL_MSG("ejabberd initialization was aborted "
+			      "because a module start failed.",
+			      []),
+		timer:sleep(3000),
+		erlang:halt(string:substr(lists:flatten(ErrorText), 1, 199))
+	  end
     end.
 
 is_app_running(AppName) ->
-    %% Use a high timeout to prevent a false positive in a high load system
     Timeout = 15000,
-    lists:keymember(AppName, 1, application:which_applications(Timeout)).
+    lists:keymember(AppName, 1,
+		    application:which_applications(Timeout)).
+
+-spec stop_module(binary(), atom()) -> error | {aborted, any()} | {atomic, any()}.
 
-%% @doc Stop the module in a host, and forget its configuration.
 stop_module(Host, Module) ->
     case stop_module_keep_config(Host, Module) of
-	error ->
-	    error;
-	ok ->
-	    del_module_mnesia(Host, Module)
+      error -> error;
+      ok -> del_module_mnesia(Host, Module)
     end.
 
-%% @doc Stop the module in a host, but keep its configuration.
-%% As the module configuration is kept in the Mnesia local_config table,
-%% when ejabberd is restarted the module will be started again.
-%% This function is useful when ejabberd is being stopped
-%% and it stops all modules.
+-spec stop_module_keep_config(binary(), atom()) -> error | ok.
+
 stop_module_keep_config(Host, Module) ->
     case catch Module:stop(Host) of
-	{'EXIT', Reason} ->
-	    ?ERROR_MSG("~p", [Reason]),
-	    error;
-	{wait, ProcList} when is_list(ProcList) ->
-	    lists:foreach(fun wait_for_process/1, ProcList),
-	    ets:delete(ejabberd_modules, {Module, Host}),
-	    ok;
-	{wait, Process} ->
-	    wait_for_process(Process),
-	    ets:delete(ejabberd_modules, {Module, Host}),
-	    ok;
-	_ ->
-	    ets:delete(ejabberd_modules, {Module, Host}),
-	    ok
+      {'EXIT', Reason} -> ?ERROR_MSG("~p", [Reason]), error;
+      {wait, ProcList} when is_list(ProcList) ->
+	  lists:foreach(fun wait_for_process/1, ProcList),
+	  ets:delete(ejabberd_modules, {Module, Host}),
+	  ok;
+      {wait, Process} ->
+	  wait_for_process(Process),
+	  ets:delete(ejabberd_modules, {Module, Host}),
+	  ok;
+      _ -> ets:delete(ejabberd_modules, {Module, Host}), ok
     end.
 
 wait_for_process(Process) ->
@@ -128,136 +125,157 @@ wait_for_process(Process) ->
 
 wait_for_stop(Process, MonitorReference) ->
     receive
-	{'DOWN', MonitorReference, _Type, _Object, _Info} ->
-	    ok
-    after 5000 ->
-	    catch exit(whereis(Process), kill),
-	    wait_for_stop1(MonitorReference)
+      {'DOWN', MonitorReference, _Type, _Object, _Info} -> ok
+      after 5000 ->
+		catch exit(whereis(Process), kill),
+		wait_for_stop1(MonitorReference)
     end.
 
 wait_for_stop1(MonitorReference) ->
     receive
-	{'DOWN', MonitorReference, _Type, _Object, _Info} ->
-	    ok
-    after 5000 ->
-	    ok
+      {'DOWN', MonitorReference, _Type, _Object, _Info} -> ok
+      after 5000 -> ok
     end.
 
-get_opt(Opt, Opts) ->
+-type check_fun() :: fun((any()) -> any()) | {module(), atom()}.
+
+-spec get_opt(atom(), opts(), check_fun()) -> any().
+
+get_opt(Opt, Opts, F) ->
+    get_opt(Opt, Opts, F, undefined).
+
+-spec get_opt(atom(), opts(), check_fun(), any()) -> any().
+
+get_opt(Opt, Opts, F, Default) ->
     case lists:keysearch(Opt, 1, Opts) of
-	false ->
-	    % TODO: replace with more appropriate function
-	    throw({undefined_option, Opt});
-	{value, {_, Val}} ->
-	    Val
+        false ->
+            Default;
+        {value, {_, Val}} ->
+            ejabberd_config:prepare_opt_val(Opt, Val, F, Default)
     end.
 
-get_opt(Opt, Opts, Default) ->
-    case lists:keysearch(Opt, 1, Opts) of
-	false ->
-	    Default;
-	{value, {_, Val}} ->
-	    Val
-    end.
+-spec get_module_opt(global | binary(), atom(), atom(), check_fun(), any()) -> any().
 
-get_module_opt(global, Module, Opt, Default) ->
-	Hosts = ?MYHOSTS,
-	[Value | Values] = lists:map(
-		fun(Host) ->
-			get_module_opt(Host, Module, Opt, Default)
-		end,
-		Hosts),
-	Same_all = lists:all(
-		fun(Other_value) ->
-			Other_value == Value
-		end,
-		Values),
-	case Same_all of
-		true -> Value;
-		false -> Default
-	end;
-
-get_module_opt(Host, Module, Opt, Default) ->
+get_module_opt(global, Module, Opt, F, Default) ->
+    Hosts = (?MYHOSTS),
+    [Value | Values] = lists:map(fun (Host) ->
+					 get_module_opt(Host, Module, Opt,
+							F, Default)
+				 end,
+				 Hosts),
+    Same_all = lists:all(fun (Other_value) ->
+				 Other_value == Value
+			 end,
+			 Values),
+    case Same_all of
+      true -> Value;
+      false -> Default
+    end;
+get_module_opt(Host, Module, Opt, F, Default) ->
     OptsList = ets:lookup(ejabberd_modules, {Module, Host}),
     case OptsList of
-	[] ->
-	    Default;
-	[#ejabberd_module{opts = Opts} | _] ->
-	    get_opt(Opt, Opts, Default)
+      [] -> Default;
+      [#ejabberd_module{opts = Opts} | _] ->
+	  get_opt(Opt, Opts, F, Default)
     end.
 
+-spec get_module_opt_host(global | binary(), atom(), binary()) -> binary().
+
 get_module_opt_host(Host, Module, Default) ->
-    Val = get_module_opt(Host, Module, host, Default),
-    ejabberd_regexp:greplace(Val, "@HOST@", Host).
+    Val = get_module_opt(Host, Module, host,
+                         fun iolist_to_binary/1,
+                         Default),
+    ejabberd_regexp:greplace(Val, <<"@HOST@">>, Host).
+
+-spec get_opt_host(binary(), opts(), binary()) -> binary().
 
 get_opt_host(Host, Opts, Default) ->
-    Val = get_opt(host, Opts, Default),
-    ejabberd_regexp:greplace(Val, "@HOST@", Host).
+    Val = get_opt(host, Opts, fun iolist_to_binary/1, Default),
+    ejabberd_regexp:greplace(Val, <<"@HOST@">>, Host).
+
+-spec db_type(opts()) -> db_type().
 
 db_type(Opts) ->
-    case get_opt(db_type, Opts, mnesia) of
-        odbc -> odbc;
-        _ -> mnesia
-    end.
+    get_opt(db_type, Opts,
+            fun(odbc) -> odbc;
+               (internal) -> mnesia;
+               (mnesia) -> mnesia;
+               (riak) -> riak
+            end,
+            mnesia).
+
+-spec db_type(binary(), atom()) -> db_type().
 
 db_type(Host, Module) ->
-    case get_module_opt(Host, Module, db_type, mnesia) of
-        odbc -> odbc;
-        _ -> mnesia
-    end.
+    get_module_opt(Host, Module, db_type,
+                   fun(odbc) -> odbc;
+                      (internal) -> mnesia;
+                      (mnesia) -> mnesia;
+                      (riak) -> riak
+                   end,
+                   mnesia).
+
+-spec loaded_modules(binary()) -> [atom()].
 
 loaded_modules(Host) ->
     ets:select(ejabberd_modules,
 	       [{#ejabberd_module{_ = '_', module_host = {'$1', Host}},
-		 [],
-		 ['$1']}]).
+		 [], ['$1']}]).
+
+-spec loaded_modules_with_opts(binary()) -> [{atom(), opts()}].
 
 loaded_modules_with_opts(Host) ->
     ets:select(ejabberd_modules,
 	       [{#ejabberd_module{_ = '_', module_host = {'$1', Host},
 				  opts = '$2'},
-		 [],
-		 [{{'$1', '$2'}}]}]).
+		 [], [{{'$1', '$2'}}]}]).
 
 set_module_opts_mnesia(Host, Module, Opts) ->
-    Modules = case ejabberd_config:get_local_option({modules, Host}) of
-		  undefined ->
-		      [];
-		  Ls ->
-		      Ls
-	      end,
+    Modules = ejabberd_config:get_local_option(
+                {modules, Host},
+                fun(Ls) when is_list(Ls) -> Ls end,
+                []),
     Modules1 = lists:keydelete(Module, 1, Modules),
     Modules2 = [{Module, Opts} | Modules1],
-    ejabberd_config:add_local_option({modules, Host}, Modules2).
+    ejabberd_config:add_local_option({modules, Host},
+				     Modules2).
 
 del_module_mnesia(Host, Module) ->
-    Modules = case ejabberd_config:get_local_option({modules, Host}) of
-		  undefined ->
-		      [];
-		  Ls ->
-		      Ls
-	      end,
+    Modules = ejabberd_config:get_local_option(
+                {modules, Host},
+                fun(Ls) when is_list(Ls) -> Ls end,
+                []),
     Modules1 = lists:keydelete(Module, 1, Modules),
-    ejabberd_config:add_local_option({modules, Host}, Modules1).
+    ejabberd_config:add_local_option({modules, Host},
+				     Modules1).
+
+-spec get_hosts(opts(), binary()) -> [binary()].
 
 get_hosts(Opts, Prefix) ->
-    case catch gen_mod:get_opt(hosts, Opts) of
-	{'EXIT', _Error1} ->
-	    case catch gen_mod:get_opt(host, Opts) of
-		{'EXIT', _Error2} ->
-		    [Prefix ++ Host || Host <- ?MYHOSTS];
-		Host ->
-		    [Host]
-	    end;
-	Hosts ->
-	    Hosts
+    case get_opt(hosts, Opts,
+                 fun(Hs) -> [iolist_to_binary(H) || H <- Hs] end) of
+        undefined ->
+            case get_opt(host, Opts,
+                         fun iolist_to_binary/1) of
+                undefined ->
+                    [<<Prefix/binary, Host/binary>> || Host <- ?MYHOSTS];
+                Host ->
+                    [Host]
+            end;
+        Hosts ->
+            Hosts
     end.
 
+-spec get_module_proc(binary(), {frontend, atom()} | atom()) -> atom().
+
 get_module_proc(Host, {frontend, Base}) ->
-    get_module_proc("frontend_" ++ Host, Base);
+    get_module_proc(<<"frontend_", Host/binary>>, Base);
 get_module_proc(Host, Base) ->
-    list_to_atom(atom_to_list(Base) ++ "_" ++ Host).
+    binary_to_atom(
+      <<(erlang:atom_to_binary(Base, latin1))/binary, "_", Host/binary>>,
+      latin1).
+
+-spec is_loaded(binary(), atom()) -> boolean().
 
 is_loaded(Host, Module) ->
     ets:member(ejabberd_modules, {Module, Host}).
-

src/http_p1.erl

@@ -0,0 +1,333 @@
+%%%----------------------------------------------------------------------
+%%% File    : http_p1.erl
+%%% Author  : Emilio Bustos <ebustos@process-one.net>
+%%% Purpose : Provide a common API for inets / lhttpc / ibrowse
+%%% Created : 29 Jul 2010 by Emilio Bustos <ebustos@process-one.net>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2013   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., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-module(http_p1).
+
+-author('ebustos@process-one.net').
+
+-export([start/0, stop/0, get/1, get/2, post/2, post/3,
+	 request/3, request/4, request/5]).
+
+% -define(USE_INETS, 1).
+% -define(USE_LHTTPC, 1).
+% -define(USE_IBROWSE, 1).
+% inets used as default if none specified
+
+-ifdef(USE_IBROWSE).
+
+start() ->
+    ibrowse:start(),
+    ssl:start().
+
+stop() ->
+    ibrowse:stop().
+
+request(Method, URL, Hdrs, Body, Opts) ->
+    TimeOut = proplists:get_value(timeout, Opts, infinity),
+    Options = [{inactivity_timeout, TimeOut}
+	       | proplists:delete(timeout, Opts)],
+    case ibrowse:send_req(URL, Hdrs, Method, Body, Options)
+	of
+      {ok, Status, Headers, Response} ->
+	  {ok, jlib:binary_to_integer(Status), Headers,
+	   Response};
+      {error, Reason} -> {error, Reason}
+    end.
+
+-else.
+
+-ifdef(USE_LHTTPC).
+
+start() ->
+    application:start(crypto),
+    application:start(ssl),
+    lhttpc:start().
+
+stop() ->
+    lhttpc:stop(),
+    application:stop(ssl).
+
+request(Method, URL, Hdrs, Body, Opts) ->
+    TimeOut = proplists:get_value(timeout, Opts, infinity),
+    SockOpt = proplists:get_value(socket_options, Opts, []),
+    Options = [{connect_options, SockOpt}
+	       | proplists:delete(timeout, Opts)],
+    case lhttpc:request(URL, Method, Hdrs, Body, TimeOut,
+			Options)
+	of
+      {ok, {{Status, _Reason}, Headers, Response}} ->
+	  {ok, Status, Headers, (Response)};
+      {error, Reason} -> {error, Reason}
+    end.
+
+-else.
+
+start() ->
+    inets:start(),
+    ssl:start().
+
+stop() ->
+    inets:stop(),
+    ssl:stop().
+
+to_list(Str) when is_binary(Str) ->
+    binary_to_list(Str);
+to_list(Str) ->
+    Str.
+
+request(Method, URLRaw, HdrsRaw, Body, Opts) ->
+    Hdrs = lists:map(fun({N, V}) ->
+                             {to_list(N), to_list(V)}
+                     end, HdrsRaw),
+    URL = to_list(URLRaw),
+
+    Request = case Method of
+		get -> {URL, Hdrs};
+		head -> {URL, Hdrs};
+		_ -> % post, etc.
+		    {URL, Hdrs,
+		     to_list(proplists:get_value(<<"content-type">>, HdrsRaw, [])),
+                     Body}
+	      end,
+    Options = case proplists:get_value(timeout, Opts,
+				       infinity)
+		  of
+		infinity -> proplists:delete(timeout, Opts);
+		_ -> Opts
+	      end,
+    case httpc:request(Method, Request, Options, []) of
+      {ok, {{_, Status, _}, Headers, Response}} ->
+	  {ok, Status, Headers, Response};
+      {error, Reason} -> {error, Reason}
+    end.
+
+-endif.
+
+-endif.
+
+-type({header,
+       {type, 63, tuple,
+	[{type, 63, union,
+	  [{type, 63, string, []}, {type, 63, atom, []}]},
+	 {type, 63, string, []}]},
+       []}).
+
+-type({headers,
+       {type, 64, list, [{type, 64, header, []}]}, []}).
+
+-type({option,
+       {type, 67, union,
+	[{type, 67, tuple,
+	  [{atom, 67, connect_timeout}, {type, 67, timeout, []}]},
+	 {type, 68, tuple,
+	  [{atom, 68, timeout}, {type, 68, timeout, []}]},
+	 {type, 70, tuple,
+	  [{atom, 70, send_retry},
+	   {type, 70, non_neg_integer, []}]},
+	 {type, 71, tuple,
+	  [{atom, 71, partial_upload},
+	   {type, 71, union,
+	    [{type, 71, non_neg_integer, []},
+	     {atom, 71, infinity}]}]},
+	 {type, 72, tuple,
+	  [{atom, 72, partial_download}, {type, 72, pid, []},
+	   {type, 72, union,
+	    [{type, 72, non_neg_integer, []},
+	     {atom, 72, infinity}]}]}]},
+       []}).
+
+-type({options,
+       {type, 74, list, [{type, 74, option, []}]}, []}).
+
+-type({result,
+       {type, 76, union,
+	[{type, 76, tuple,
+	  [{atom, 76, ok},
+	   {type, 76, tuple,
+	    [{type, 76, tuple,
+	      [{type, 76, pos_integer, []}, {type, 76, string, []}]},
+	     {type, 76, headers, []}, {type, 76, string, []}]}]},
+	 {type, 77, tuple,
+	  [{atom, 77, error}, {type, 77, atom, []}]}]},
+       []}).
+
+%% @spec (URL) -> Result
+%%   URL = string()
+%%   Result = {ok, StatusCode, Hdrs, ResponseBody}
+%%            | {error, Reason}
+%%   StatusCode = integer()
+%%   ResponseBody = string()
+%%   Reason = connection_closed | connect_timeout | timeout
+%% @doc Sends a GET request.
+%% Would be the same as calling `request(get, URL, [])',
+%% that is {@link request/3} with an empty header list.
+%% @end
+%% @see request/3
+-spec get(string()) -> result().
+get(URL) -> request(get, URL, []).
+
+%% @spec (URL, Hdrs) -> Result
+%%   URL = string()
+%%   Hdrs = [{Header, Value}]
+%%   Header = string()
+%%   Value = string()
+%%   Result = {ok, StatusCode, Hdrs, ResponseBody}
+%%            | {error, Reason}
+%%   StatusCode = integer()
+%%   ResponseBody = string()
+%%   Reason = connection_closed | connect_timeout | timeout
+%% @doc Sends a GET request.
+%% Would be the same as calling `request(get, URL, Hdrs)'.
+%% @end
+%% @see request/3
+-spec get(string(), headers()) -> result().
+get(URL, Hdrs) -> request(get, URL, Hdrs).
+
+%% @spec (URL, RequestBody) -> Result
+%%   URL = string()
+%%   RequestBody = string()
+%%   Result = {ok, StatusCode, Hdrs, ResponseBody}
+%%            | {error, Reason}
+%%   StatusCode = integer()
+%%   ResponseBody = string()
+%%   Reason = connection_closed | connect_timeout | timeout
+%% @doc Sends a POST request with form data.
+%% Would be the same as calling
+%% `request(post, URL, [{"content-type", "x-www-form-urlencoded"}], Body)'.
+%% @end
+%% @see request/4
+-spec post(string(), string()) -> result().
+post(URL, Body) ->
+    request(post, URL,
+	    [{<<"content-type">>, <<"x-www-form-urlencoded">>}],
+	    Body).
+
+%% @spec (URL, Hdrs, RequestBody) -> Result
+%%   URL = string()
+%%   Hdrs = [{Header, Value}]
+%%   Header = string()
+%%   Value = string()
+%%   RequestBody = string()
+%%   Result = {ok, StatusCode, Hdrs, ResponseBody}
+%%            | {error, Reason}
+%%   StatusCode = integer()
+%%   ResponseBody = string()
+%%   Reason = connection_closed | connect_timeout | timeout
+%% @doc Sends a POST request.
+%% Would be the same as calling
+%% `request(post, URL, Hdrs, Body)'.
+%% @end
+%% @see request/4
+-spec post(string(), headers(), string()) -> result().
+post(URL, Hdrs, Body) ->
+    NewHdrs = case [X
+		    || {X, _} <- Hdrs,
+		       str:to_lower(X) == <<"content-type">>]
+		  of
+		[] ->
+		    [{<<"content-type">>, <<"x-www-form-urlencoded">>}
+		     | Hdrs];
+		_ -> Hdrs
+	      end,
+    request(post, URL, NewHdrs, Body).
+
+%% @spec (Method, URL, Hdrs) -> Result
+%%   Method = atom()
+%%   URL = string()
+%%   Hdrs = [{Header, Value}]
+%%   Header = string()
+%%   Value = string()
+%%   Result = {ok, StatusCode, Hdrs, ResponseBody}
+%%            | {error, Reason}
+%%   StatusCode = integer()
+%%   ResponseBody = string()
+%%   Reason = connection_closed | connect_timeout | timeout
+%% @doc Sends a request without a body.
+%% Would be the same as calling `request(Method, URL, Hdrs, [], [])',
+%% that is {@link request/5} with an empty body.
+%% @end
+%% @see request/5
+-spec request(atom(), string(), headers()) -> result().
+request(Method, URL, Hdrs) ->
+    request(Method, URL, Hdrs, [], []).
+
+%% @spec (Method, URL, Hdrs, RequestBody) -> Result
+%%   Method = atom()
+%%   URL = string()
+%%   Hdrs = [{Header, Value}]
+%%   Header = string()
+%%   Value = string()
+%%   RequestBody = string()
+%%   Result = {ok, StatusCode, Hdrs, ResponseBody}
+%%            | {error, Reason}
+%%   StatusCode = integer()
+%%   ResponseBody = string()
+%%   Reason = connection_closed | connect_timeout | timeout
+%% @doc Sends a request with a body.
+%% Would be the same as calling
+%% `request(Method, URL, Hdrs, Body, [])', that is {@link request/5}
+%% with no options.
+%% @end
+%% @see request/5
+-spec request(atom(), string(), headers(), string()) -> result().
+request(Method, URL, Hdrs, Body) ->
+    request(Method, URL, Hdrs, Body, []).
+
+%% @spec (Method, URL, Hdrs, RequestBody, Options) -> Result
+%%   Method = atom()
+%%   URL = string()
+%%   Hdrs = [{Header, Value}]
+%%   Header = string()
+%%   Value = string()
+%%   RequestBody = string()
+%%   Options = [Option]
+%%   Option = {timeout, Milliseconds | infinity} |
+%%            {connect_timeout, Milliseconds | infinity} |
+%%            {socket_options, [term()]} |
+
+%%   Milliseconds = integer()
+%%   Result = {ok, StatusCode, Hdrs, ResponseBody}
+%%            | {error, Reason}
+%%   StatusCode = integer()
+%%   ResponseBody = string()
+%%   Reason = connection_closed | connect_timeout | timeout
+%% @doc Sends a request with a body.
+%% Would be the same as calling
+%% `request(Method, URL, Hdrs, Body, [])', that is {@link request/5}
+%% with no options.
+%% @end
+%% @see request/5
+-spec request(atom(), string(), headers(), string(), options()) -> result().
+
+% ibrowse {response_format, response_format()} |
+% Options - [option()]
+%                     Option - {sync, boolean()} | {stream, StreamTo} | {body_format, body_format()} | {full_result,
+%                     boolean()} | {headers_as_is, boolean()}
+%body_format() = string() | binary()
+%                       The body_format option is only valid for the synchronous request and the default is  string.
+%                     When making an asynchronous request the body will always be received as a binary.
+% lhttpc: always binary
+

src/idna.erl

@@ -5,7 +5,7 @@
 %%% Created : 10 Apr 2004 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
-%%% ejabberd, Copyright (C) 2002-2012   ProcessOne
+%%% ejabberd, Copyright (C) 2002-2013   ProcessOne
 %%%
 %%% This program is free software; you can redistribute it and/or
 %%% modify it under the terms of the GNU General Public License as
@@ -25,172 +25,182 @@
 %%%----------------------------------------------------------------------
 
 -module(idna).
+
 -author('alexey@process-one.net').
 
 %%-compile(export_all).
 -export([domain_utf8_to_ascii/1,
-	 domain_ucs2_to_ascii/1]).
+	 domain_ucs2_to_ascii/1,
+         utf8_to_ucs2/1]).
 
+-spec domain_utf8_to_ascii(binary()) -> false | binary().
 
 domain_utf8_to_ascii(Domain) ->
     domain_ucs2_to_ascii(utf8_to_ucs2(Domain)).
 
 utf8_to_ucs2(S) ->
-    utf8_to_ucs2(S, "").
+    list_to_binary(utf8_to_ucs2(binary_to_list(S), "")).
 
-utf8_to_ucs2([], R) ->
-    lists:reverse(R);
-utf8_to_ucs2([C | S], R) when C < 16#80 ->
+utf8_to_ucs2([], R) -> lists:reverse(R);
+utf8_to_ucs2([C | S], R) when C < 128 ->
     utf8_to_ucs2(S, [C | R]);
-utf8_to_ucs2([C1, C2 | S], R) when C1 < 16#E0 ->
-    utf8_to_ucs2(S, [((C1 band 16#1F) bsl 6) bor
-		     (C2 band 16#3F) | R]);
-utf8_to_ucs2([C1, C2, C3 | S], R) when C1 < 16#F0 ->
-    utf8_to_ucs2(S, [((C1 band 16#0F) bsl 12) bor
-		     ((C2 band 16#3F) bsl 6) bor
-		     (C3 band 16#3F) | R]).
+utf8_to_ucs2([C1, C2 | S], R) when C1 < 224 ->
+    utf8_to_ucs2(S, [C1 band 31 bsl 6 bor C2 band 63 | R]);
+utf8_to_ucs2([C1, C2, C3 | S], R) when C1 < 240 ->
+    utf8_to_ucs2(S,
+		 [C1 band 15 bsl 12 bor (C2 band 63 bsl 6) bor C3 band 63
+		  | R]).
 
+-spec domain_ucs2_to_ascii(binary()) -> false | binary().
 
 domain_ucs2_to_ascii(Domain) ->
-    case catch domain_ucs2_to_ascii1(Domain) of
-	{'EXIT', _Reason} ->
-	    false;
-	Res ->
-	    Res
+    case catch domain_ucs2_to_ascii1(binary_to_list(Domain)) of
+      {'EXIT', _Reason} -> false;
+      Res -> iolist_to_binary(Res)
     end.
 
 domain_ucs2_to_ascii1(Domain) ->
-    Parts = string:tokens(Domain, [16#002E, 16#3002, 16#FF0E, 16#FF61]),
-    ASCIIParts = lists:map(fun(P) ->
-				   to_ascii(P)
-			   end, Parts),
-    string:strip(lists:flatmap(fun(P) -> [$. | P] end, ASCIIParts),
+    Parts = string:tokens(Domain,
+			  [46, 12290, 65294, 65377]),
+    ASCIIParts = lists:map(fun (P) -> to_ascii(P) end,
+			   Parts),
+    string:strip(lists:flatmap(fun (P) -> [$. | P] end,
+			       ASCIIParts),
 		 left, $.).
 
 %% Domain names are already nameprep'ed in ejabberd, so we skiping this step
 to_ascii(Name) ->
-    false = lists:any(
-	      fun(C) when
-		 (    0 =< C) and (C =< 16#2C) or
-		 (16#2E =< C) and (C =< 16#2F) or
-		 (16#3A =< C) and (C =< 16#40) or
-		 (16#5B =< C) and (C =< 16#60) or
-		 (16#7B =< C) and (C =< 16#7F) ->
-		      true;
-		 (_) ->
-		      false
-	      end, Name),
+    false = lists:any(fun (C)
+			      when (0 =< C) and (C =< 44) or
+				     (46 =< C) and (C =< 47)
+				     or (58 =< C) and (C =< 64)
+				     or (91 =< C) and (C =< 96)
+				     or (123 =< C) and (C =< 127) ->
+			      true;
+			  (_) -> false
+		      end,
+		      Name),
     case Name of
-	[H | _] when H /= $- ->
-	    true = lists:last(Name) /= $-
+      [H | _] when H /= $- -> true = lists:last(Name) /= $-
     end,
-    ASCIIName = case lists:any(fun(C) -> C > 16#7F end, Name) of
-		    true ->
-			true = case Name of
-				   "xn--" ++ _ -> false;
-				   _ -> true
-			       end,
-			"xn--" ++ punycode_encode(Name);
-		    false ->
-			Name
+    ASCIIName = case lists:any(fun (C) -> C > 127 end, Name)
+		    of
+		  true ->
+		      true = case Name of
+			       "xn--" ++ _ -> false;
+			       _ -> true
+			     end,
+		      "xn--" ++ punycode_encode(Name);
+		  false -> Name
 		end,
     L = length(ASCIIName),
     true = (1 =< L) and (L =< 63),
     ASCIIName.
 
-
 %%% PUNYCODE (RFC3492)
 
--define(BASE,         36).
--define(TMIN,         1).
--define(TMAX,         26).
--define(SKEW,         38).
--define(DAMP,         700).
+-define(BASE, 36).
+
+-define(TMIN, 1).
+
+-define(TMAX, 26).
+
+-define(SKEW, 38).
+
+-define(DAMP, 700).
+
 -define(INITIAL_BIAS, 72).
--define(INITIAL_N,    128).
+
+-define(INITIAL_N, 128).
 
 punycode_encode(Input) ->
-    N = ?INITIAL_N,
+    N = (?INITIAL_N),
     Delta = 0,
-    Bias = ?INITIAL_BIAS,
-    Basic = lists:filter(fun(C) -> C =< 16#7f end, Input),
-    NonBasic = lists:filter(fun(C) -> C > 16#7f end, Input),
+    Bias = (?INITIAL_BIAS),
+    Basic = lists:filter(fun (C) -> C =< 127 end, Input),
+    NonBasic = lists:filter(fun (C) -> C > 127 end, Input),
     L = length(Input),
     B = length(Basic),
     SNonBasic = lists:usort(NonBasic),
-    Output1 = if
-		  B > 0 -> Basic ++ "-";
-		  true -> ""
+    Output1 = if B > 0 -> Basic ++ "-";
+		 true -> ""
 	      end,
-    Output2 = punycode_encode1(Input, SNonBasic, B, B, L, N, Delta, Bias, ""),
+    Output2 = punycode_encode1(Input, SNonBasic, B, B, L, N,
+			       Delta, Bias, ""),
     Output1 ++ Output2.
 
-
-punycode_encode1(Input, [M | SNonBasic], B, H, L, N, Delta, Bias, Out)
-  when H < L ->
+punycode_encode1(Input, [M | SNonBasic], B, H, L, N,
+		 Delta, Bias, Out)
+    when H < L ->
     Delta1 = Delta + (M - N) * (H + 1),
-						% let n = m
-    {NewDelta, NewBias, NewH, NewOut} =
-	lists:foldl(
-	  fun(C, {ADelta, ABias, AH, AOut}) ->
-		  if
-		      C < M ->
-			  {ADelta + 1, ABias, AH, AOut};
-		      C == M ->
-			  NewOut = punycode_encode_delta(ADelta, ABias, AOut),
-			  NewBias = adapt(ADelta, H + 1, H == B),
-			  {0, NewBias, AH + 1, NewOut};
-		      true ->
-			  {ADelta, ABias, AH, AOut}
-		  end
-	  end, {Delta1, Bias, H, Out}, Input),
-    punycode_encode1(
-      Input, SNonBasic, B, NewH, L, M + 1, NewDelta + 1, NewBias, NewOut);
-
-punycode_encode1(_Input, _SNonBasic, _B, _H, _L, _N, _Delta, _Bias, Out) ->
+    % let n = m
+    {NewDelta, NewBias, NewH, NewOut} = lists:foldl(fun (C,
+							 {ADelta, ABias, AH,
+							  AOut}) ->
+							    if C < M ->
+								   {ADelta + 1,
+								    ABias, AH,
+								    AOut};
+							       C == M ->
+								   NewOut =
+								       punycode_encode_delta(ADelta,
+											     ABias,
+											     AOut),
+								   NewBias =
+								       adapt(ADelta,
+									     H +
+									       1,
+									     H
+									       ==
+									       B),
+								   {0, NewBias,
+								    AH + 1,
+								    NewOut};
+							       true ->
+								   {ADelta,
+								    ABias, AH,
+								    AOut}
+							    end
+						    end,
+						    {Delta1, Bias, H, Out},
+						    Input),
+    punycode_encode1(Input, SNonBasic, B, NewH, L, M + 1,
+		     NewDelta + 1, NewBias, NewOut);
+punycode_encode1(_Input, _SNonBasic, _B, _H, _L, _N,
+		 _Delta, _Bias, Out) ->
     lists:reverse(Out).
 
-
 punycode_encode_delta(Delta, Bias, Out) ->
     punycode_encode_delta(Delta, Bias, Out, ?BASE).
 
 punycode_encode_delta(Delta, Bias, Out, K) ->
-    T = if
-	    K =< Bias         -> ?TMIN;
-	    K >= Bias + ?TMAX -> ?TMAX;
-	    true              -> K - Bias
+    T = if K =< Bias -> ?TMIN;
+	   K >= Bias + (?TMAX) -> ?TMAX;
+	   true -> K - Bias
 	end,
-    if
-	Delta < T ->
-	    [codepoint(Delta) | Out];
-	true ->
-	    C = T + ((Delta - T) rem (?BASE - T)),
-	    punycode_encode_delta((Delta - T) div (?BASE - T), Bias,
-				  [codepoint(C) | Out], K + ?BASE)
+    if Delta < T -> [codepoint(Delta) | Out];
+       true ->
+	   C = T + (Delta - T) rem ((?BASE) - T),
+	   punycode_encode_delta((Delta - T) div ((?BASE) - T),
+				 Bias, [codepoint(C) | Out], K + (?BASE))
     end.
 
-
 adapt(Delta, NumPoints, FirstTime) ->
-    Delta1 = if
-		 FirstTime -> Delta div ?DAMP;
-		 true -> Delta div 2
+    Delta1 = if FirstTime -> Delta div (?DAMP);
+		true -> Delta div 2
 	     end,
-    Delta2 = Delta1 + (Delta1 div NumPoints),
+    Delta2 = Delta1 + Delta1 div NumPoints,
     adapt1(Delta2, 0).
 
 adapt1(Delta, K) ->
-    if
-	Delta > ((?BASE - ?TMIN) * ?TMAX) div 2 ->
-	    adapt1(Delta div (?BASE - ?TMIN), K + ?BASE);
-	true ->
-	    K + (((?BASE - ?TMIN + 1) * Delta) div (Delta + ?SKEW))
+    if Delta > ((?BASE) - (?TMIN)) * (?TMAX) div 2 ->
+	   adapt1(Delta div ((?BASE) - (?TMIN)), K + (?BASE));
+       true ->
+	   K +
+	     ((?BASE) - (?TMIN) + 1) * Delta div (Delta + (?SKEW))
     end.
 
-
 codepoint(C) ->
-    if
-	(0 =< C) and (C =< 25) ->
-	    C + 97;
-	(26 =< C) and (C =< 35) ->
-	    C + 22
+    if (0 =< C) and (C =< 25) -> C + 97;
+       (26 =< C) and (C =< 35) -> C + 22
     end.