SIP support

Conflicts:
	configure
	configure.ac
	doc/guide.tex

4 files changed, 788 insertions, 0 deletions

diff --git a/src/ejabberd_listener.erl b/src/ejabberd_listener.erl
index 2051afdb..71f74407 100644
--- a/src/ejabberd_listener.erl
+++ b/src/ejabberd_listener.erl
@@ -151,6 +151,19 @@ init_udp(PortIP, Module, Opts, SockOpts, Port, IPS) ->
 	{ok, Socket} ->
 	    %% Inform my parent that this port was opened succesfully
 	    proc_lib:init_ack({ok, self()}),
+	    case erlang:function_exported(Module, udp_init, 2) of
+		true ->
+		    case catch Module:udp_init(Socket, Opts) of
+			{'EXIT', _} = Err ->
+			    ?ERROR_MSG("failed to process callback function "
+				       "~p:~s(~p, ~p): ~p",
+				       [Module, udp_init, Socket, Opts, Err]);
+			_ ->
+			    ok
+		    end;
+		false ->
+		    ok
+	    end,
 	    udp_recv(Socket, Module, Opts);
 	{error, Reason} ->
 	    socket_error(Reason, PortIP, Module, SockOpts, Port, IPS)
@@ -160,6 +173,19 @@ init_tcp(PortIP, Module, Opts, SockOpts, Port, IPS) ->
     ListenSocket = listen_tcp(PortIP, Module, SockOpts, Port, IPS),
     %% Inform my parent that this port was opened succesfully
     proc_lib:init_ack({ok, self()}),
+    case erlang:function_exported(Module, tcp_init, 2) of
+	true ->
+	    case catch Module:tcp_init(ListenSocket, Opts) of
+		{'EXIT', _} = Err ->
+		    ?ERROR_MSG("failed to process callback function "
+			       "~p:~s(~p, ~p): ~p",
+			       [Module, tcp_init, ListenSocket, Opts, Err]);
+		_ ->
+		    ok
+	    end;
+	false ->
+	    ok
+    end,
     %% And now start accepting connection attempts
     accept(ListenSocket, Module, Opts).
 
@@ -342,6 +368,7 @@ start_listener2(Port, Module, Opts) ->
     %% But it doesn't hurt to attempt to start it for any listener.
     %% So, it's normal (and harmless) that in most cases this call returns: {error, {already_started, pid()}}
     maybe_start_stun(Module),
+    maybe_start_sip(Module),
     start_module_sup(Port, Module),
     start_listener_sup(Port, Module, Opts).
 
@@ -463,6 +490,11 @@ maybe_start_stun(ejabberd_stun) ->
 maybe_start_stun(_) ->
     ok.
 
+maybe_start_sip(esip_socket) ->
+    ejabberd:start_app(esip);
+maybe_start_sip(_) ->
+    ok.
+
 %%%
 %%% Check options
 %%%
@@ -642,7 +674,11 @@ prepare_ip(IP) when is_binary(IP) ->
 
 prepare_mod(ejabberd_stun) ->
     prepare_mod(stun);
+prepare_mod(ejabberd_sip) ->
+    prepare_mod(sip);
 prepare_mod(stun) ->
     stun;
+prepare_mod(sip) ->
+    esip_socket;
 prepare_mod(Mod) when is_atom(Mod) ->
     Mod.
diff --git a/src/mod_sip.erl b/src/mod_sip.erl
new file mode 100644
index 00000000..cca91a33
--- /dev/null
+++ b/src/mod_sip.erl
@@ -0,0 +1,404 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2014, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 21 Apr 2014 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(mod_sip).
+
+-behaviour(gen_mod).
+-behaviour(esip).
+
+%% API
+-export([start/2, stop/1, prepare_request/1, make_response/2,
+	 add_certfile/2, add_via/3]).
+
+%% esip_callbacks
+-export([data_in/2, data_out/2, message_in/2, message_out/2,
+	 request/2, request/3, response/2, locate/1]).
+
+-include("ejabberd.hrl").
+-include("logger.hrl").
+-include("esip.hrl").
+
+-record(sip_session, {us = {<<"">>, <<"">>} :: {binary(), binary()},
+		      socket = #sip_socket{},
+		      timestamp = now() :: erlang:timestamp(),
+		      tref = make_ref() :: reference(),
+		      expires = 0 :: non_neg_integer()}).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+start(_Host, _Opts) ->
+    ejabberd:start_app(esip),
+    esip:set_config_value(max_server_transactions, 10000),
+    esip:set_config_value(max_client_transactions, 10000),
+    esip:set_config_value(software, <<"ejabberd ", (?VERSION)/binary>>),
+    esip:set_config_value(module, ?MODULE),
+    Spec = {mod_sip_registrar, {mod_sip_registrar, start_link, []},
+	    transient, 2000, worker, [mod_sip_registrar]},
+    TmpSupSpec = {mod_sip_proxy_sup,
+		  {ejabberd_tmp_sup, start_link,
+		   [mod_sip_proxy_sup, mod_sip_proxy]},
+		  permanent, infinity, supervisor, [ejabberd_tmp_sup]},
+    supervisor:start_child(ejabberd_sup, Spec),
+    supervisor:start_child(ejabberd_sup, TmpSupSpec),
+    ok.
+
+stop(_Host) ->
+    ok.
+
+data_in(Data, #sip_socket{type = Transport,
+                          addr = {MyIP, MyPort},
+                          peer = {PeerIP, PeerPort}}) ->
+    ?DEBUG(
+       "SIP [~p/in] ~s:~p -> ~s:~p:~n~s",
+       [Transport, inet_parse:ntoa(PeerIP), PeerPort,
+	inet_parse:ntoa(MyIP), MyPort, Data]).
+
+data_out(Data, #sip_socket{type = Transport,
+                           addr = {MyIP, MyPort},
+                           peer = {PeerIP, PeerPort}}) ->
+    ?DEBUG(
+       "SIP [~p/out] ~s:~p -> ~s:~p:~n~s",
+       [Transport, inet_parse:ntoa(MyIP), MyPort,
+	inet_parse:ntoa(PeerIP), PeerPort, Data]).
+
+message_in(#sip{type = request, method = M} = Req, SIPSock)
+  when M /= <<"ACK">>, M /= <<"CANCEL">> ->
+    case action(Req, SIPSock) of
+        {relay, _LServer, _Opts} ->
+            ok;
+        Action ->
+            request(Req, SIPSock, undefined, Action)
+    end;
+message_in(_, _) ->
+    ok.
+
+message_out(_, _) ->
+    ok.
+
+response(Resp, SIPSock) ->
+    case action(Resp, SIPSock) of
+        {relay, LServer, Opts} ->
+            case esip:split_hdrs('via', Resp#sip.hdrs) of
+                {[_], _} ->
+                    ok;
+                {[_MyVia|Vias], TailHdrs} ->
+		    %% TODO: check if MyVia is really my Via
+		    NewResp = Resp#sip{hdrs = [{'via', Vias}|TailHdrs]},
+		    case proplists:get_value(socket, Opts) of
+			undefined ->
+			    case esip:connect(NewResp,
+					      add_certfile(LServer, Opts)) of
+				{ok, SIPSockOut} ->
+				    esip:send(SIPSockOut, NewResp);
+				{error, _} ->
+				    ok
+			    end;
+			SIPSockOut ->
+			    esip:send(SIPSockOut, NewResp)
+		    end
+            end;
+        _ ->
+            ok
+    end.
+
+request(#sip{method = <<"ACK">>} = Req, SIPSock) ->
+    case action(Req, SIPSock) of
+        {relay, LServer, Opts} ->
+	    Req1 = prepare_request(Req),
+	    case esip:connect(Req1, add_certfile(LServer, Opts)) of
+		{ok, SIPSockOut} ->
+		    Req2 = add_via(SIPSockOut, LServer, Req1),
+		    esip:send(SIPSockOut, Req2);
+		{error, _} = Err ->
+		    Err
+	    end;
+        _ ->
+            pass
+    end;
+request(#sip{method = <<"CANCEL">>} = Req, SIPSock) ->
+    case action(Req, SIPSock) of
+        loop ->
+            make_response(Req, #sip{status = 483, type = response});
+        {unsupported, Require} ->
+            make_response(Req, #sip{status = 420,
+                                    type = response,
+                                    hdrs = [{'unsupported',
+                                             Require}]});
+        {relay, LServer, Opts} ->
+	    Req1 = prepare_request(Req),
+	    case esip:connect(Req1, add_certfile(LServer, Opts)) of
+		{ok, SIPSockOut} ->
+		    Req2 = add_via(SIPSockOut, LServer, Req1),
+		    esip:send(SIPSockOut, Req2);
+		{error, _} = Err ->
+		    Err
+	    end,
+            pass;
+        _ ->
+            pass
+    end.
+
+request(Req, SIPSock, TrID) ->
+    request(Req, SIPSock, TrID, action(Req, SIPSock)).
+
+request(Req, SIPSock, TrID, Action) ->
+    case Action of
+        to_me ->
+            process(Req, SIPSock);
+        register ->
+            mod_sip_registrar:request(Req, SIPSock);
+        loop ->
+            make_response(Req, #sip{status = 483, type = response});
+        {unsupported, Require} ->
+            make_response(Req, #sip{status = 420,
+                                    type = response,
+                                    hdrs = [{'unsupported',
+                                             Require}]});
+        {relay, LServer, Opts} ->
+            case mod_sip_proxy:start(LServer, Opts) of
+                {ok, Pid} ->
+                    mod_sip_proxy:route(Req, SIPSock, TrID, Pid),
+                    {mod_sip_proxy, route, [Pid]};
+                Err ->
+		    ?INFO_MSG("failed to proxy request ~p: ~p", [Req, Err]),
+                    Err
+            end;
+        {proxy_auth, Host} ->
+            make_response(
+              Req,
+              #sip{status = 407,
+                   type = response,
+                   hdrs = [{'proxy-authenticate',
+                            make_auth_hdr(Host)}]});
+        {auth, Host} ->
+            make_response(
+              Req,
+              #sip{status = 401,
+                   type = response,
+                   hdrs = [{'www-authenticate',
+                            make_auth_hdr(Host)}]});
+        deny ->
+            make_response(Req, #sip{status = 403,
+                                    type = response});
+        not_found ->
+            make_response(Req, #sip{status = 480,
+                                    type = response})
+    end.
+
+locate(_SIPMsg) ->
+    ok.
+
+find(#uri{user = User, host = Host}) ->
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Host),
+    case mod_sip_registrar:find_session(
+	   LUser, LServer) of
+	{ok, #sip_session{socket = Sock}} ->
+	    {relay, LServer, [{socket, Sock}]};
+	error ->
+	    not_found
+    end.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+action(#sip{type = response, hdrs = Hdrs}, _SIPSock) ->
+    {_, ToURI, _} = esip:get_hdr('to', Hdrs),
+    {_, FromURI, _} = esip:get_hdr('from', Hdrs),
+    case at_my_host(FromURI) of
+	true ->
+	    case at_my_host(ToURI) of
+		true ->
+		    find(ToURI);
+		false ->
+		    LServer = jlib:nameprep(FromURI#uri.host),
+		    {relay, LServer, []}
+	    end;
+	false ->
+	    case at_my_host(ToURI) of
+		true ->
+		    find(ToURI);
+		false ->
+		    pass
+	    end
+    end;
+action(#sip{method = <<"REGISTER">>, type = request, hdrs = Hdrs,
+            uri = #uri{user = <<"">>} = URI} = Req, SIPSock) ->
+    case at_my_host(URI) of
+	true ->
+	    case esip:get_hdrs('require', Hdrs) of
+		[_|_] = Require ->
+		    {unsupported, Require};
+		_ ->
+		    {_, ToURI, _} = esip:get_hdr('to', Hdrs),
+		    case at_my_host(ToURI) of
+			true ->
+			    case check_auth(Req, 'authorization', SIPSock) of
+				true ->
+				    register;
+				false ->
+				    {auth, ToURI#uri.host}
+			    end;
+			false ->
+			    deny
+		    end
+	    end;
+	false ->
+	    deny
+    end;
+action(#sip{method = Method, hdrs = Hdrs, type = request} = Req, SIPSock) ->
+    case esip:get_hdr('max-forwards', Hdrs) of
+        0 when Method == <<"OPTIONS">> ->
+            to_me;
+        0 ->
+            loop;
+        _ ->
+            case esip:get_hdrs('proxy-require', Hdrs) of
+                [_|_] = Require ->
+                    {unsupported, Require};
+                _ ->
+                    {_, ToURI, _} = esip:get_hdr('to', Hdrs),
+                    {_, FromURI, _} = esip:get_hdr('from', Hdrs),
+		    case at_my_host(FromURI) of
+			true ->
+			    case check_auth(Req, 'proxy-authorization', SIPSock) of
+                                true ->
+				    case at_my_host(ToURI) of
+					true ->
+					    find(ToURI);
+					false ->
+					    LServer = jlib:nameprep(FromURI#uri.host),
+					    {relay, LServer, []}
+				    end;
+                                false ->
+                                    {proxy_auth, FromURI#uri.host}
+                            end;
+			false ->
+			    case at_my_host(ToURI) of
+				true ->
+				    find(ToURI);
+				false ->
+				    deny
+			    end
+                    end
+            end
+    end.
+
+check_auth(#sip{method = <<"CANCEL">>}, _, _SIPSock) ->
+    true;
+check_auth(#sip{method = Method, hdrs = Hdrs, body = Body}, AuthHdr, _SIPSock) ->
+    
+    Issuer = case AuthHdr of
+                 'authorization' ->
+                     to;
+                 'proxy-authorization' ->
+                     from
+             end,
+    {_, #uri{user = User, host = Host}, _} = esip:get_hdr(Issuer, Hdrs),
+    LUser = jlib:nodeprep(User),
+    LServer = jlib:nameprep(Host),
+    case lists:filter(
+           fun({_, Params}) ->
+                   Username = esip:get_param(<<"username">>, Params),
+                   Realm = esip:get_param(<<"realm">>, Params),
+                   (LUser == esip:unquote(Username))
+                       and (LServer == esip:unquote(Realm))
+           end, esip:get_hdrs(AuthHdr, Hdrs)) of
+        [Auth|_] ->
+	    case ejabberd_auth:get_password_s(LUser, LServer) of
+		<<"">> ->
+		    false;
+		Password ->
+		    esip:check_auth(Auth, Method, Body, Password)
+	    end;
+        [] ->
+            false
+    end.
+
+allow() ->
+    [<<"OPTIONS">>, <<"REGISTER">>].
+
+process(#sip{method = <<"OPTIONS">>} = Req, _) ->
+    make_response(Req, #sip{type = response, status = 200,
+                            hdrs = [{'allow', allow()}]});
+process(#sip{method = <<"REGISTER">>} = Req, _) ->
+    make_response(Req, #sip{type = response, status = 400});
+process(Req, _) ->
+    make_response(Req, #sip{type = response, status = 405,
+			    hdrs = [{'allow', allow()}]}).
+
+prepare_request(#sip{hdrs = Hdrs1} = Req) ->
+    MF = esip:get_hdr('max-forwards', Hdrs1),
+    Hdrs2 = esip:set_hdr('max-forwards', MF-1, Hdrs1),
+    Hdrs3 = lists:filter(
+              fun({'proxy-authorization', {_, Params}}) ->
+                      Realm = esip:unquote(esip:get_param(<<"realm">>, Params)),
+		      not is_my_host(jlib:nameprep(Realm));
+                 (_) ->
+                      true
+              end, Hdrs2),
+    Req#sip{hdrs = Hdrs3}.
+
+make_auth_hdr(LServer) ->
+    Realm = jlib:nameprep(LServer),
+    {<<"Digest">>, [{<<"realm">>, esip:quote(Realm)},
+                    {<<"qop">>, esip:quote(<<"auth">>)},
+                    {<<"nonce">>, esip:quote(esip:make_hexstr(20))}]}.
+
+make_response(Req, Resp) ->
+    esip:make_response(Req, Resp, esip:make_tag()).
+
+at_my_host(#uri{host = Host}) ->
+    is_my_host(jlib:nameprep(Host)).
+
+is_my_host(LServer) ->
+    gen_mod:is_loaded(LServer, ?MODULE).
+
+add_certfile(LServer, Opts) ->
+    case ejabberd_config:get_option({domain_certfile, LServer},
+				    fun iolist_to_binary/1) of
+	CertFile when is_binary(CertFile), CertFile /= <<"">> ->
+	    [{certfile, CertFile}|Opts];
+	_ ->
+	    Opts
+    end.
+
+add_via(#sip_socket{type = Transport}, LServer, #sip{hdrs = Hdrs} = Req) ->
+    ConfiguredVias = get_configured_vias(LServer),
+    {ViaHost, ViaPort} = proplists:get_value(
+			   Transport, ConfiguredVias, {LServer, undefined}),
+    ViaTransport = case Transport of
+		       tls -> <<"TLS">>;
+		       tcp -> <<"TCP">>;
+		       udp -> <<"UDP">>
+		   end,
+    Via = #via{transport = ViaTransport,
+	       host = ViaHost,
+	       port = ViaPort,
+	       params = [{<<"branch">>, esip:make_branch()},
+			 {<<"rport">>, <<"">>}]},
+    Req#sip{hdrs = [{'via', [Via]}|Hdrs]}.
+
+get_configured_vias(LServer) ->
+    gen_mod:get_module_opt(
+      LServer, ?MODULE, via,
+      fun(L) ->
+	      lists:map(
+		fun(Opts) ->
+			Type = proplists:get_value(type, Opts),
+			Host = proplists:get_value(host, Opts),
+			Port = proplists:get_value(port, Opts),
+			true = (Type == tcp) or (Type == tls) or (Type == udp),
+			true = is_binary(Host) and (Host /= <<"">>),
+			true = (is_integer(Port)
+				and (Port > 0) and (Port < 65536))
+			    or (Port == undefined),
+			{Type, {Host, Port}}
+		end, L)
+      end, []).
diff --git a/src/mod_sip_proxy.erl b/src/mod_sip_proxy.erl
new file mode 100644
index 00000000..aa749ccf
--- /dev/null
+++ b/src/mod_sip_proxy.erl
@@ -0,0 +1,152 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2014, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 21 Apr 2014 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(mod_sip_proxy).
+
+-define(GEN_FSM, p1_fsm).
+-behaviour(?GEN_FSM).
+
+%% API
+-export([start/2, start_link/2, route/4, route/5]).
+
+%% gen_fsm callbacks
+-export([init/1, wait_for_request/2, wait_for_response/2,
+	 handle_event/3, handle_sync_event/4,
+	 handle_info/3, terminate/3, code_change/4]).
+
+-include("ejabberd.hrl").
+-include("logger.hrl").
+-include("esip.hrl").
+
+-define(MAX_REDIRECTS, 5).
+
+-record(state, {host = <<"">> :: binary(),
+		opts = []     :: [{certfile, binary()}],
+		orig_trid,
+		orig_req      :: #sip{},
+		client_trid}).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+start(LServer, Opts) ->
+    supervisor:start_child(mod_sip_proxy_sup, [LServer, Opts]).
+
+start_link(LServer, Opts) ->
+    ?GEN_FSM:start_link(?MODULE, [LServer, Opts], []).
+
+route(Resp, Req, _SIPSock, TrID, Pid) ->
+    ?GEN_FSM:send_event(Pid, {Resp, Req, TrID}).
+
+route(SIPMsg, _SIPSock, TrID, Pid) ->
+    ?GEN_FSM:send_event(Pid, {SIPMsg, TrID}),
+    wait.
+
+%%%===================================================================
+%%% gen_fsm callbacks
+%%%===================================================================
+init([Host, Opts]) ->
+    {ok, wait_for_request, #state{opts = Opts, host = Host}}.
+
+wait_for_request({#sip{type = request} = Req, TrID}, State) ->
+    Opts = mod_sip:add_certfile(State#state.host, State#state.opts),
+    Req1 = mod_sip:prepare_request(Req),
+    case connect(Req1, Opts) of
+	{ok, SIPSocket} ->
+	    Req2 = mod_sip:add_via(SIPSocket, State#state.host, Req1),
+	    case esip:request(SIPSocket, Req2, {?MODULE, route, [self()]}) of
+		{ok, ClientTrID} ->
+		    {next_state, wait_for_response,
+		     State#state{orig_trid = TrID,
+				 orig_req = Req,
+				 client_trid = ClientTrID}};
+		Err ->
+		    {Status, Reason} = esip:error_status(Err),
+		    esip:reply(TrID, mod_sip:make_response(
+				       Req, #sip{type = response,
+						 status = Status,
+						 reason = Reason})),
+		    {stop, normal, State}
+	    end;
+	Err ->
+	    {Status, Reason} = esip:error_status(Err),
+	    esip:reply(TrID, mod_sip:make_response(
+			       Req, #sip{type = response,
+					 status = Status,
+					 reason = Reason})),
+	    {stop, normal, State}
+    end;
+wait_for_request(_Event, State) ->
+    {next_state, wait_for_request, State}.
+
+wait_for_response({#sip{method = <<"CANCEL">>, type = request}, _TrID}, State) ->
+    esip:cancel(State#state.client_trid),
+    {next_state, wait_for_response, State};
+wait_for_response({Resp, _TrID}, State) ->
+    case Resp of
+        {error, _} ->
+	    Req = State#state.orig_req,
+            {Status, Reason} = esip:error_status(Resp),
+            case Status of
+                408 when Req#sip.method /= <<"INVITE">> ->
+                    %% Absorb useless 408. See RFC4320
+                    esip:stop_transaction(State#state.orig_trid);
+                _ ->
+                    ErrResp = mod_sip:make_response(
+				Req,
+				#sip{type = response,
+				     status = Status,
+				     reason = Reason}),
+		    esip:reply(State#state.orig_trid, ErrResp)
+            end,
+            {stop, normal, State};
+        #sip{status = 100} ->
+            {next_state, wait_for_response, State};
+        #sip{status = Status} ->
+            case esip:split_hdrs('via', Resp#sip.hdrs) of
+                {[_], _} ->
+                    {stop, normal, State};
+                {[_|Vias], NewHdrs} ->
+                    esip:reply(State#state.orig_trid,
+                               Resp#sip{hdrs = [{'via', Vias}|NewHdrs]}),
+                    if Status < 200 ->
+                            {next_state, wait_for_response, State};
+                       true ->
+                            {stop, normal, State}
+                    end
+            end
+    end;
+wait_for_response(_Event, State) ->
+    {next_state, wait_for_response, State}.
+
+handle_event(_Event, StateName, State) ->
+    {next_state, StateName, State}.
+
+handle_sync_event(_Event, _From, StateName, State) ->
+    Reply = ok,
+    {reply, Reply, StateName, State}.
+
+handle_info(_Info, StateName, State) ->
+    {next_state, StateName, State}.
+
+terminate(_Reason, _StateName, _State) ->
+    ok.
+
+code_change(_OldVsn, StateName, State, _Extra) ->
+    {ok, StateName, State}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+connect(Req, Opts) ->
+    case proplists:get_value(socket, Opts) of
+	undefined ->
+	    esip:connect(Req, Opts);
+	#sip_socket{} = SIPSock ->
+	    {ok, SIPSock}
+    end.
diff --git a/src/mod_sip_registrar.erl b/src/mod_sip_registrar.erl
new file mode 100644
index 00000000..d8f485fe
--- /dev/null
+++ b/src/mod_sip_registrar.erl
@@ -0,0 +1,196 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2014, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 23 Apr 2014 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(mod_sip_registrar).
+
+-define(GEN_SERVER, p1_server).
+-behaviour(?GEN_SERVER).
+
+%% API
+-export([start_link/0, request/2, find_session/2]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+	 terminate/2, code_change/3]).
+
+-include("ejabberd.hrl").
+-include("logger.hrl").
+-include("esip.hrl").
+
+-record(sip_session, {us = {<<"">>, <<"">>} :: {binary(), binary()},
+		      socket = #sip_socket{},
+		      timestamp = now() :: erlang:timestamp(),
+		      tref = make_ref() :: reference(),
+		      expires = 0 :: non_neg_integer()}).
+
+-record(state, {}).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+start_link() ->
+    ?GEN_SERVER:start_link({local, ?MODULE}, ?MODULE, [], []).
+
+request(#sip{hdrs = Hdrs} = Req, SIPSock) ->
+    {_, #uri{user = U, host = S}, _} = esip:get_hdr('to', Hdrs),
+    LUser = jlib:nodeprep(U),
+    LServer = jlib:nameprep(S),
+    {PeerIP, _} = SIPSock#sip_socket.peer,
+    US = {LUser, LServer},
+    Expires = esip:get_hdr('expires', Hdrs, 0),
+    case esip:get_hdrs('contact', Hdrs) of
+        [<<"*">>] when Expires == 0 ->
+	    ?INFO_MSG("unregister SIP session for user ~s@~s from ~s",
+		      [LUser, LServer, inet_parse:ntoa(PeerIP)]),
+            unregister_session(US),
+            mod_sip:make_response(Req, #sip{type = response, status = 200});
+        [{_, _URI, _Params}|_] = Contacts ->
+            ContactsWithExpires =
+		lists:map(
+		  fun({Name, URI, Params}) ->
+			  Exp = case to_integer(
+				       esip:get_param(
+					 <<"expires">>, Params),
+				       0, (1 bsl 32)-1) of
+				    {ok, E} -> E;
+				    _ -> Expires
+				end,
+			  NewParams = esip:set_param(
+					<<"expires">>,
+					erlang:integer_to_binary(Exp),
+					Params),
+			  {Exp, {Name, URI, NewParams}}
+		  end, Contacts),
+	    [{Expires1, _}|_] = lists:keysort(1, ContactsWithExpires),
+	    MinExpires = min_expires(),
+            if Expires1 >= MinExpires ->
+		    ?INFO_MSG("register SIP session for user ~s@~s from ~s",
+			      [LUser, LServer, inet_parse:ntoa(PeerIP)]),
+		    register_session(US, SIPSock, Expires1),
+                    mod_sip:make_response(
+		      Req,
+		      #sip{type = response,
+			   status = 200,
+			   hdrs = [{'contact',
+				    [C || {_, C} <- ContactsWithExpires]}]});
+               Expires1 > 0, Expires1 < MinExpires ->
+                    mod_sip:make_response(
+		      Req, #sip{type = response,
+				status = 423,
+				hdrs = [{'min-expires', MinExpires}]});
+               true ->
+		    ?INFO_MSG("unregister SIP session for user ~s@~s from ~s",
+			      [LUser, LServer, inet_parse:ntoa(PeerIP)]),
+                    unregister_session(US),
+                    mod_sip:make_response(
+		      Req,
+		      #sip{type = response, status = 200,
+			   hdrs = [{'contact',
+				    [C || {_, C} <- ContactsWithExpires]}]})
+            end;
+        _ ->
+            mod_sip:make_response(Req, #sip{type = response, status = 400})
+    end.
+
+find_session(U, S) ->
+    case mnesia:dirty_read(sip_session, {U, S}) of
+	[Session] ->
+	    {ok, Session};
+	[] ->
+	    error
+    end.
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+init([]) ->
+    mnesia:create_table(sip_session,
+			[{ram_copies, [node()]},
+			 {attributes, record_info(fields, sip_session)}]),
+    mnesia:add_table_copy(sip_session, node(), ram_copies),
+    {ok, #state{}}.
+
+handle_call({write, Session}, _From, State) ->
+    Res = write_session(Session),
+    {reply, Res, State};
+handle_call({delete, US}, _From, State) ->
+    Res = delete_session(US),
+    {reply, Res, State};
+handle_call(_Request, _From, State) ->
+    Reply = ok,
+    {reply, Reply, State}.
+
+handle_cast(_Msg, State) ->
+    {noreply, State}.
+
+handle_info({write, Session}, State) ->
+    write_session(Session),
+    {noreply, State};
+handle_info({delete, US}, State) ->
+    delete_session(US),
+    {noreply, State};
+handle_info({timeout, TRef, US}, State) ->
+    case mnesia:dirty_read(sip_session, US) of
+	[#sip_session{tref = TRef}] ->
+	    mnesia:dirty_delete(sip_session, US);
+	[] ->
+	    ok
+    end,
+    {noreply, State};
+handle_info(_Info, State) ->
+    ?ERROR_MSG("got unexpected info: ~p", [_Info]),
+    {noreply, State}.
+
+terminate(_Reason, _State) ->
+    ok.
+
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+register_session(US, SIPSocket, Expires) ->
+    Session = #sip_session{us = US,
+			   socket = SIPSocket,
+			   timestamp = now(),
+			   expires = Expires},
+    gen_server:call(?MODULE, {write, Session}).
+
+unregister_session(US) ->
+    gen_server:call(?MODULE, {delete, US}).
+
+write_session(#sip_session{us = US, expires = Expires} = Session) ->
+    case mnesia:dirty_read(sip_session, US) of
+	[#sip_session{tref = TRef}] ->
+	    erlang:cancel_timer(TRef);
+	[] ->
+	    ok
+    end,
+    NewTRef = erlang:start_timer(Expires * 1000, self(), US),
+    mnesia:dirty_write(Session#sip_session{tref = NewTRef}).
+
+delete_session(US) ->
+    case mnesia:dirty_read(sip_session, US) of
+	[#sip_session{tref = TRef}] ->
+	    erlang:cancel_timer(TRef),
+	    mnesia:dirty_delete(sip_session, US);
+	[] ->
+	    ok
+    end.
+
+min_expires() ->
+    60.
+
+to_integer(Bin, Min, Max) ->
+    case catch list_to_integer(binary_to_list(Bin)) of
+        N when N >= Min, N =< Max ->
+            {ok, N};
+        _ ->
+            error
+    end.