CAPTCHA IBR support (EJAB-1262)

src/ejabberd_captcha.erl

@@ -36,7 +36,8 @@
 	 terminate/2, code_change/3]).
 
 -export([create_captcha/6, build_captcha_html/2, check_captcha/2,
-	 process_reply/1, process/2, is_feature_available/0]).
+	 process_reply/1, process/2, is_feature_available/0,
+	 create_captcha_x/4, create_captcha_x/5]).
 
 -include("jlib.hrl").
 -include("ejabberd.hrl").
@@ -112,6 +113,40 @@ create_captcha(Id, SID, From, To, Lang, Args)
 	    error
     end.
 
+create_captcha_x(SID, To, Lang, HeadEls) ->
+    create_captcha_x(SID, To, Lang, HeadEls, []).
+
+create_captcha_x(SID, To, Lang, HeadEls, TailEls) ->
+    case create_image() of
+	{ok, Type, Key, Image} ->
+	    Id = randoms:get_string(),
+	    B64Image = jlib:encode_base64(binary_to_list(Image)),
+	    CID = "sha1+" ++ sha:sha(Image) ++ "@bob.xmpp.org",
+	    Data = {xmlelement, "data",
+		    [{"xmlns", ?NS_BOB}, {"cid", CID},
+		     {"max-age", "0"}, {"type", Type}],
+		    [{xmlcdata, B64Image}]},
+	    Captcha =
+		{xmlelement, "x", [{"xmlns", ?NS_XDATA}, {"type", "form"}],
+		 [?VFIELD("hidden", "FORM_TYPE", {xmlcdata, ?NS_CAPTCHA}) | HeadEls] ++
+		 [?VFIELD("hidden", "from", {xmlcdata, jlib:jid_to_string(To)}),
+		  ?VFIELD("hidden", "challenge", {xmlcdata, Id}),
+		  ?VFIELD("hidden", "sid", {xmlcdata, SID}),
+		  {xmlelement, "field", [{"var", "ocr"}, {"label", ?CAPTCHA_TEXT(Lang)}],
+		   [{xmlelement, "media", [{"xmlns", ?NS_MEDIA}],
+		     [{xmlelement, "uri", [{"type", Type}],
+		       [{xmlcdata, "cid:" ++ CID}]}]}]}] ++ TailEls},
+	    Tref = erlang:send_after(?CAPTCHA_LIFETIME, ?MODULE, {remove_id, Id}),
+	    case ?T(mnesia:write(#captcha{id=Id, key=Key, tref=Tref})) of
+		ok ->
+		    {ok, [Captcha, Data]};
+		_Err ->
+		    error
+	    end;
+	_ ->
+	    error
+    end.
+
 %% @spec (Id::string(), Lang::string()) -> {FormEl, {ImgEl, TextEl, IdEl, KeyEl}} | captcha_not_found
 %% where FormEl = xmlelement()
 %%       ImgEl = xmlelement()
@@ -155,10 +190,18 @@ check_captcha(Id, ProvidedKey) ->
 	       mnesia:delete({captcha, Id}),
 	       erlang:cancel_timer(Tref),
 	       if StoredKey == ProvidedKey ->
-		       Pid ! {captcha_succeed, Args},
+		       if is_pid(Pid) ->
+			       Pid ! {captcha_succeed, Args};
+			  true ->
+			       ok
+		       end,
 		       captcha_valid;
 		  true ->
-		       Pid ! {captcha_failed, Args},
+		       if is_pid(Pid) ->
+			       Pid ! {captcha_failed, Args};
+			  true ->
+			       ok
+		       end,
 		       captcha_non_valid
 	       end;
 	   _ ->
@@ -166,13 +209,13 @@ check_captcha(Id, ProvidedKey) ->
        end).
 
 
-process_reply({xmlelement, "captcha", _, _} = El) ->
+process_reply({xmlelement, _, _, _} = El) ->
     case xml:get_subtag(El, "x") of
 	false ->
 	    {error, malformed};
 	Xdata ->
 	    Fields = jlib:parse_xdata_submit(Xdata),
-	    case {proplists:get_value("challenge", Fields),
+	    case catch {proplists:get_value("challenge", Fields),
 			proplists:get_value("ocr", Fields)} of
 		{[Id|_], [OCR|_]} ->
 		    ?T(case mnesia:read(captcha, Id, write) of
@@ -180,10 +223,18 @@ process_reply({xmlelement, "captcha", _, _} = El) ->
 			       mnesia:delete({captcha, Id}),
 			       erlang:cancel_timer(Tref),
 			       if OCR == Key ->
-				       Pid ! {captcha_succeed, Args},
+				       if is_pid(Pid) ->
+					       Pid ! {captcha_succeed, Args};
+					  true ->
+					       ok
+				       end,
 				       ok;
 				  true ->
-				       Pid ! {captcha_failed, Args},
+				       if is_pid(Pid) ->
+					       Pid ! {captcha_failed, Args};
+					  true ->
+					       ok
+				       end,
 				       {error, bad_match}
 			       end;
 			   _ ->
@@ -266,7 +317,11 @@ handle_info({remove_id, Id}, State) ->
     ?DEBUG("captcha ~p timed out", [Id]),
     _ = ?T(case mnesia:read(captcha, Id, write) of
 	       [#captcha{args=Args, pid=Pid}] ->
-		   Pid ! {captcha_failed, Args},
+		   if is_pid(Pid) ->
+			   Pid ! {captcha_failed, Args};
+		      true ->
+			   ok
+		   end,
 		   mnesia:delete({captcha, Id});
 	       _ ->
 		   ok

src/mod_register.erl

@@ -93,6 +93,13 @@ process_iq(From, To, IQ) ->
 process_iq(From, To,
 	   #iq{type = Type, lang = Lang, sub_el = SubEl, id = ID} = IQ,
 	   Source) ->
+    IsCaptchaEnabled = case gen_mod:get_module_opt(
+			      To#jid.lserver, ?MODULE, captcha, false) of
+			   true ->
+			       true;
+			   _ ->
+			       false
+		       end,
     case Type of
 	set ->
 	    UTag = xml:get_subtag(SubEl, "username"),
@@ -162,10 +169,101 @@ process_iq(From, To,
 		(UTag /= false) and (PTag /= false) ->
 		    User = xml:get_tag_cdata(UTag),
 		    Password = xml:get_tag_cdata(PTag),
+		    try_register_or_set_password(
+		      User, Server, Password, From,
+		      IQ, SubEl, Source, Lang, not IsCaptchaEnabled);
+		IsCaptchaEnabled ->
+		    case ejabberd_captcha:process_reply(SubEl) of
+			ok ->
+			    case process_xdata_submit(SubEl) of
+				{ok, User, Password} ->
+				    try_register_or_set_password(
+				      User, Server, Password, From,
+				      IQ, SubEl, Source, Lang, true);
+				_ ->
+				    IQ#iq{type = error,
+					  sub_el = [SubEl, ?ERR_BAD_REQUEST]}
+			    end;
+			{error, malformed} ->
+			    IQ#iq{type = error,
+				  sub_el = [SubEl, ?ERR_BAD_REQUEST]};
+			_ ->
+			    ErrText = "Captcha test failed",
+			    IQ#iq{type = error,
+				  sub_el = [SubEl,
+					    ?ERRT_NOT_ALLOWED(Lang, ErrText)]}
+		    end;
+		true ->
+		    IQ#iq{type = error,
+			  sub_el = [SubEl, ?ERR_BAD_REQUEST]}
+	    end;
+	get ->
+	    {IsRegistered, UsernameSubels, QuerySubels} =
+		case From of
+		    #jid{user = User, lserver = Server} ->
+			case ejabberd_auth:is_user_exists(User,Server) of
+			    true ->
+				{true, [{xmlcdata, User}],
+				 [{xmlelement, "registered", [], []}]};
+			    false ->
+				{false, [{xmlcdata, User}], []}
+			end;
+		    _ ->
+			{false, [], []}
+		end,
+	    if IsCaptchaEnabled and not IsRegistered ->
+		    InstrEl = {xmlelement, "instructions", [],
+			       [{xmlcdata,
+				 translate:translate(
+				   Lang,
+				   "Choose a username and password "
+				   "to register with this server")}]},
+		    UField = {xmlelement, "field",
+			      [{"type", "text-single"},
+			       {"label", translate:translate(Lang, "User")},
+			       {"var", "username"}],
+			      [{xmlelement, "required", [], []}]},
+		    PField = {xmlelement, "field",
+			      [{"type", "text-private"},
+			       {"label", translate:translate(Lang, "Password")},
+			       {"var", "password"}],
+			      [{xmlelement, "required", [], []}]},
+		    case ejabberd_captcha:create_captcha_x(
+			   ID, To, Lang, [InstrEl, UField, PField]) of
+			{ok, CaptchaEls} ->
+			    IQ#iq{type = result,
+				  sub_el = [{xmlelement, "query",
+					     [{"xmlns", "jabber:iq:register"}],
+					     CaptchaEls}]};
+			error ->
+			    ErrText = "Unable to generate a captcha",
+			    IQ#iq{type = error,
+				  sub_el = [SubEl, ?ERRT_INTERNAL_SERVER_ERROR(
+						      Lang, ErrText)]}
+		    end;
+	       true ->
+		    IQ#iq{type = result,
+			  sub_el = [{xmlelement,
+				     "query",
+				     [{"xmlns", "jabber:iq:register"}],
+				     [{xmlelement, "instructions", [],
+				       [{xmlcdata,
+					 translate:translate(
+					   Lang,
+					   "Choose a username and password "
+					   "to register with this server")}]},
+				      {xmlelement, "username", [], UsernameSubels},
+				      {xmlelement, "password", [], []}
+				      | QuerySubels]}]}
+	    end
+    end.
+
+try_register_or_set_password(User, Server, Password, From, IQ,
+			     SubEl, Source, Lang, CaptchaSucceed) ->
     case From of
 	#jid{user = User, lserver = Server} ->
 	    try_set_password(User, Server, Password, IQ, SubEl);
-			_ ->
+	_ when CaptchaSucceed ->
 	    case check_from(From, Server) of
 		allow ->
 		    case try_register(User, Server, Password,
@@ -180,38 +278,10 @@ process_iq(From, To,
 		deny ->
 		    IQ#iq{type = error,
 			  sub_el = [SubEl, ?ERR_FORBIDDEN]}
-			    end
-		    end;
-		true ->
-		    IQ#iq{type = error,
-			  sub_el = [SubEl, ?ERR_BAD_REQUEST]}
-	    end;
-	get ->
-	    {UsernameSubels, QuerySubels} =
-		case From of
-		    #jid{user = User, lserver = Server} ->
-			case ejabberd_auth:is_user_exists(User,Server) of
-			    true ->
-				{[{xmlcdata, User}], [{xmlelement, "registered", [], []}]};
-			    false ->
-				{[{xmlcdata, User}], []}
 	    end;
 	_ ->
-			{[], []}
+	    IQ#iq{type = error,
-		end,
+		  sub_el = [SubEl, ?ERR_NOT_ALLOWED]}
-	    IQ#iq{type = result,
-		  sub_el = [{xmlelement,
-			     "query",
-			     [{"xmlns", "jabber:iq:register"}],
-			     [{xmlelement, "instructions", [],
-			       [{xmlcdata,
-				 translate:translate(
-				   Lang,
-				   "Choose a username and password "
-				   "to register with this server")}]},
-			      {xmlelement, "username", [], UsernameSubels},
-			      {xmlelement, "password", [], []}
-			      | QuerySubels]}]}
     end.
 
 %% @doc Try to change password and return IQ response
@@ -417,3 +487,18 @@ get_time_string() -> write_time(erlang:localtime()).
 write_time({{Y,Mo,D},{H,Mi,S}}) ->
     io_lib:format("~w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w",
 		  [Y, Mo, D, H, Mi, S]).
+
+process_xdata_submit(El) ->
+    case xml:get_subtag(El, "x") of
+        false ->
+	    error;
+        Xdata ->
+            Fields = jlib:parse_xdata_submit(Xdata),
+            case catch {proplists:get_value("username", Fields),
+			proplists:get_value("password", Fields)} of
+                {[User|_], [Pass|_]} ->
+		    {ok, User, Pass};
+		_ ->
+		    error
+	    end
+    end.