Index: src/Makefile.in =================================================================== --- src/Makefile.in (.../vendor/ejabberd/1.1.2) (revision 39233) +++ src/Makefile.in (.../trunk/im/ejabberd) (revision 39233) @@ -82,6 +82,7 @@ install: all install -d $(BEAMDIR) install -m 644 *.beam $(BEAMDIR) + install -m 644 mysql/*.beam $(BEAMDIR) rm -f $(BEAMDIR)/configure.beam install -m 644 *.app $(BEAMDIR) install -d $(SODIR) Index: src/extauth.erl =================================================================== --- src/extauth.erl (.../vendor/ejabberd/1.1.2) (revision 39233) +++ src/extauth.erl (.../trunk/im/ejabberd) (revision 39233) @@ -12,6 +12,7 @@ -export([start/2, stop/1, init/2, check_password/3, set_password/3, is_user_exists/2]). +-include("ejabberd.hrl"). start(Host, ExtPrg) -> spawn(?MODULE, init, [Host, ExtPrg]). @@ -58,7 +59,7 @@ exit(normal) end; {'EXIT', Port, Reason} -> - io:format("~p ~n", [Reason]), + ?INFO_MSG("ExtAuth: ~p", [Reason]), exit(port_terminated) end. Index: src/mod_keyword.erl =================================================================== --- src/mod_keyword.erl (.../vendor/ejabberd/1.1.2) (revision 0) +++ src/mod_keyword.erl (.../trunk/im/ejabberd) (revision 39233) @@ -0,0 +1,316 @@ +%%%---------------------------------------------------------------------- +%%% File : mod_keyword.erl +%%% Author : Chris Hobbs +%%% Purpose : Keyword Filtering +%%% Created : 09 Jan 2007 +%%%---------------------------------------------------------------------- + +-module(mod_keyword). +-author('chobbs@barracuda.com'). +-vsn('$Revision$ '). + +-behaviour(gen_mod). + +-export([start/2, stop/1, + filter_packet/1, reload_regexes/0]). + +-include("ejabberd.hrl"). +-include("jlib.hrl"). + +%% Register and remove our hooks +start(_Host, _Opts) -> + % Get the block list from the config for this host and add them to + % a corresponding ets entry + BlockList = ejabberd_config:get_local_option({keyword_block_list, _Host}), + FilterList = ejabberd_config:get_local_option({keyword_filter_list, _Host}), + catch ets:new(keyword_lists, [named_table, set, public]), + ets:insert(keyword_lists, {{blocklist, _Host}, BlockList}), + ets:insert(keyword_lists, {{filterlist, _Host}, FilterList}), + + % Set the hook that will get run for our packet filtering + ejabberd_hooks:add(filter_packet, global, ?MODULE, filter_packet, 100). + +stop(_Host) -> + % Remove our hook from the list of packet filter hooks + ejabberd_hooks:delete(filter_packet, global, ?MODULE, filter_packet, 100). + + +reload_regexes() -> + {_, Config} = application:get_env(config), + ejabberd_config:load_file(Config), + reload_keywords(). + +%% Return drop to drop the packet, or the original input to let it through. +%% From and To are jid records. +filter_packet(drop) -> + drop; +filter_packet({From, To, _Packet} = Input) -> + Body = xml:get_subtag(_Packet, "body"), + if + Body /= false -> + % Make sure the sender isn't the "notifier" since we don't want + % to cause an infinite loop + CompareRes = string:equal(jlib:jid_to_string(From), "notifier"), + if + CompareRes == true -> + Input; + true -> + % Get the domain name of the sender so we can use their filter rules + Data = xml:get_tag_cdata(Body), + case check_keywords(Data, From#jid.lserver, From, To) of + % Data matched a block filter - discard the packet + {ok, drop} -> + drop; + % Data matched nothing so just allow it in the orig form + {ok, allow} -> + Input; + % Matched the filter text, so we need to build a new + % packet with the filtered text as a replacement + {ok, NewText} -> + NewPacket = build_new_packet(NewText, _Packet), + {From, To, NewPacket}; + % Default case of no matching so we simply allow it + % in its orignal form + true -> + Input + end + end; + true -> + Input + end. + + +%% Function to reload the set of keywords from our configuration for all of +%% our hosts. +%% +%% Returns no specific value. +reload_keywords() -> + % Define the function to reload the keywords for each host. + ReloadKeywordsFun = fun(_Host) -> + % Load the keywords from the config + BlockList = ejabberd_config:get_local_option({keyword_block_list, _Host}), + FilterList = ejabberd_config:get_local_option({keyword_filter_list, _Host}), + + % Load the new ets entries to replace the old ones + ets:insert(keyword_lists, {{blocklist, _Host}, BlockList}), + ets:insert(keyword_lists, {{filterlist, _Host}, FilterList}) + end, + + % Operate on all of the hosts in the configuration + lists:foreach(ReloadKeywordsFun, ?MYHOSTS). + +%% Function to check a given message body against the currently registered +%% keywords. +%% +%% Returns {ok, drop}, {ok, allow}, or {ok, filtered text} depending on if any +%% keywords matched and whether they were set to block or filter. +check_keywords(Text, Host, From, To) -> + % Start with the list of blocked keywords. If any of these match then + % we will immediately return 'drop' + Res = check_block_list(Text, Host, From, To), + if + Res == drop -> + {ok, drop}; + true -> + % Didn't match the block list so we can try to the + % filter list now + NewText = check_filter_list(Text, Host, From, To), + if + % Nothing needs to be done since the text is the same and + % thus didn't match any filters + NewText == Text -> + {ok, allow}; + % Our text was filtered so send back those results + true -> + {ok, NewText} + end + end. + + +%% Function to check a given string against the block list. +%% Returns ok, or drop depending on whether we have a match +check_block_list(Text, Host, From, To) -> + % Define the check block function - Note: it needs to + % operate on the keyword tuple we define below + CheckBlockFun = fun(Entry) -> + {keyword, RegExp, _, _, _, _, _, _} = Entry, + is_regexp_match(Text, RegExp) + end, + + % Get the Block list from the config for the source host + % + % Note: each keyword entry is in the following form + % {keyword, Keyword, reason, Reason, im_notify, + % NotifyList, email_notify, NotifyList}} + [{_, BlockEntries}] = ets:lookup(keyword_lists, {blocklist, Host}), + + % Build our array of keyword + % Iterate over the list of blocked keywords and check whether our message + % matches each keyword regexp + Elements = lists:filter(CheckBlockFun, BlockEntries), + if + % We matched so grab the first element that matched and use that as + % our reason for the block + [] /= Elements -> + [FirstElem | Rest] = Elements, + process_keyword_match(FirstElem, "Block", From, To), + drop; + true -> + ok + end. + + +%% Function to check a given string against the filter list. +%% Returns ok, or the filtered text if we have a match. +check_filter_list(Text, Host, From, To) -> + % Because we can have multiple keywords, yet can't change a variable, + % we are going to recurse through the filtered keyword list carrying the + % current text with us to each call. This will allow us to filter mutiple + % keywords in a single message + + % Get the filter list from the config for the source host + % + % Note: each keyword entry is in the following form + % {keyword, Keyword, reason, Reason, im_notify, + % NotifyList, email_notify, NotifyList}} + [{_, FilterEntries}] = ets:lookup(keyword_lists, {filterlist, Host}), + + % Make the call to apply the list of filters to the text + FilteredText = apply_filters(Text, From, To, FilterEntries). + + +%% Function borrowed from acl.pm to check a string against a regexp +is_regexp_match(String, RegExp) -> + case regexp:first_match(String, RegExp) of + nomatch -> + false; + {match, _, _} -> + true; + {error, ErrDesc} -> + ?ERROR_MSG( + "Wrong regexp ~p in Keyword Blocking: ~p", + [RegExp, lists:flatten(regexp:format_error(ErrDesc))]), + false + end. + + +%% Function to apply the first filter in the filter list to the given +%% text. It recurses through all of the filters and sends back the +%% fully filtered text (the orig if no filters match). +apply_filters(Text, From, To, [FirstFilter | Rest]) -> + % Extract the actual filter to apply from the tuple that we use + % to store the keyword, reason, notify info. + {keyword, RegExp, _, _, _, _, _, _} = FirstFilter, + + % Apply the first filter to the text + case regexp:gsub(Text, RegExp, "####") of + {ok, NewText, RepCount} -> + % If we matched 1 or more then do the processing so we can + % notify the proper people + if + RepCount /= 0 -> + process_keyword_match(FirstFilter, "Filter", From, To), + ok; + true -> + ok + end, + apply_filters(NewText, From, To, Rest); + {error, ErrDesc} -> + ?ERROR_MSG( + "Wrong regexp ~p in Keyword Filtering: ~p", + [FirstFilter, lists:flatten(regexp:format_error(ErrDesc))]) + end; + +apply_filters(Text, From, To, []) -> + % Just send back the text, we have no more filters to apply + Text. + + +%% Function to build a new packet to house the filtered text and replace +%% the original version we were given. +%% +%% Returns a packet in the same form as the input packet, but with the +%% filtered text. +build_new_packet(Text, {xmlelement, Name, Attrs, Elements}) -> + % This should be our message packet. Grab the first elements, which should + % be the cdata & body, so we can mangle the cdata for the new packet + [Cdata | Rest1] = Elements, + [Body | Rest] = Rest1, + + % Build a new Body element to replace the old one by matching the contents + % and simply replacing the body's cdata section. + {xmlelement, BodyName, BodyAttrs, BodyCdata} = Body, + NewCdata = [{xmlcdata, Text}], + NewBody = {xmlelement, BodyName, BodyAttrs, NewCdata}, + + % Build the new packet to return + NewPacket = {xmlelement, Name, Attrs, lists:append([Cdata, NewBody], Rest)}. + + +%% Function to place a message into the system queue for notification by IM/email +%% when a keyword is matched +process_keyword_match(Entry, Type, From, To) -> + % Break apart our entry into the components + {keyword, Exp, reason, Reason, im_notify, IM_List, email_notify, Email_List} = Entry, + + % Handle any im notification that needs to happen + IM_Fun = fun(Jid) -> + send_notify("IM", Exp, Reason, Type, From, To, Jid) + end, + lists:foreach(IM_Fun, IM_List), + + % Handle any email notification that needs to happen + Email_Fun = fun(Email) -> + if + Email /= "" -> + send_notify("Email", Exp, Reason, Type, From, To, Email); + true -> + ok + end + end, + lists:foreach(Email_Fun, Email_List). + + +%% Function to send a notification with the given info +send_notify(Format, Exp, Reason, Type, From, To, Addr) -> + % Get a couple filenames to write to for the temp and destination + {TmpFile, DstFile} = get_notify_files(), + + % Open a temp file that we can write to (hide it from the + % notifier by starting it with a dot) + {Res, File} = file:open(TmpFile, [write]), + + % Write out the initial header based on the format + case Format of + "IM" -> + io:format(File, "~s~n", [Addr]); + "Email" -> + io:format(File, "EMAIL:~s~n", [Addr]); + true -> + ?INFO_MSG("Unable to notify with format: ~s", [Format]) + end, + + % Write out the rest of the notification file + io:format(File, "IM ~s notification.~n~nMessage From: ~s To: ~s~nMatching: ~s~nReason: ~s~n", + [Type,jlib:jid_to_string(From), jlib:jid_to_string(To), Exp, Reason]), + + % Close the file + file:close(File), + + % Rename to the dest location + file:rename(TmpFile, DstFile). + +%% Function to retrieve some random filenames with the full path used +%% by the notification engine. Send back a tmp file and the final file +%% as a single tuple. +get_notify_files() -> + % Get a random number to use for the filename + Rand = random:uniform(999999), + + % Build the filenames based on the random number + BaseDir = "/var/spool/notification/", + FileName = string:concat("n.", integer_to_list(Rand)), + TmpName = string:concat(".", FileName), + File = string:concat(BaseDir, FileName), + TmpFile = string:concat(BaseDir, TmpName), + {TmpFile, File}. Index: src/ejabberd_sm.erl =================================================================== --- src/ejabberd_sm.erl (.../vendor/ejabberd/1.1.2) (revision 39233) +++ src/ejabberd_sm.erl (.../trunk/im/ejabberd) (revision 39233) @@ -430,16 +430,18 @@ "error" -> ok; _ -> - case ejabberd_auth:is_user_exists(LUser, LServer) of - true -> - ejabberd_hooks:run(offline_message_hook, - LServer, - [From, To, Packet]); - _ -> - Err = jlib:make_error_reply( - Packet, ?ERR_SERVICE_UNAVAILABLE), - ejabberd_router:route(To, From, Err) - end + %%case ejabberd_auth:is_user_exists(LUser, LServer) of + %%true -> + %% ejabberd_hooks:run(offline_message_hook, + %% LServer, + %% [From, To, Packet]); + %%_ -> + %% Err = jlib:make_error_reply( + %% Packet, ?ERR_SERVICE_UNAVAILABLE), + %% ejabberd_router:route(To, From, Err) + %%end + ejabberd_hooks:run(offline_message_hook, LServer, + [From, To, Packet]) end end. Index: src/ejabberd_auth_external.erl =================================================================== --- src/ejabberd_auth_external.erl (.../vendor/ejabberd/1.1.2) (revision 39233) +++ src/ejabberd_auth_external.erl (.../trunk/im/ejabberd) (revision 39233) @@ -26,6 +26,8 @@ plain_password_required/0 ]). +-include("ejabberd.hrl"). + %%%---------------------------------------------------------------------- %%% API %%%---------------------------------------------------------------------- @@ -38,7 +40,24 @@ true. check_password(User, Server, Password) -> - extauth:check_password(User, Server, Password). + % Catch the check password attempt - since if our auth program has exited + % for some reason we will fail + case catch(extauth:check_password(User, Server, Password)) of + {'EXIT', Reason} -> + % The auth program died/exited ... we are going to start the prog + % back up and then return false denying this login. Checking the + % password again here fails for some reason so we just won't let + % the user on. The next time they try it will work properly. + LServer = jlib:nameprep(Server), + start(LServer), + false; + false -> + % Authentication didnt error out, but didn't succeed + false; + true -> + % Authentication succeeded so send back true + true + end. check_password(User, Server, Password, _StreamID, _Digest) -> check_password(User, Server, Password). Index: src/mod_vcard_odbc.erl =================================================================== --- src/mod_vcard_odbc.erl (.../vendor/ejabberd/1.1.2) (revision 39233) +++ src/mod_vcard_odbc.erl (.../trunk/im/ejabberd) (revision 39233) @@ -27,6 +27,18 @@ -define(PROCNAME, ejabberd_mod_vcard). start(Host, Opts) -> + % Startup the odbc supervisor when this module is started. Standard ejabberd + % behavior is to only load the odbc stuff when it is used for the auth method. + % We want to load up for just the vcard since we need to use external auth. + % This code is copy/pasted from the odbc auth module. + ChildSpec = + {gen_mod:get_module_proc(Host, ejabberd_odbc_sup), + {ejabberd_odbc_sup, start_link, [Host]}, + transient, + infinity, + supervisor, + [ejabberd_odbc_sup]}, + supervisor:start_child(ejabberd_sup, ChildSpec), ejabberd_hooks:add(remove_user, Host, ?MODULE, remove_user, 50), IQDisc = gen_mod:get_opt(iqdisc, Opts, one_queue), @@ -124,18 +136,35 @@ #jid{user = User, lserver = LServer} = From, case lists:member(LServer, ?MYHOSTS) of true -> - set_vcard(User, LServer, SubEl), + % CH: Note - we don't allow publishing but even if + % we do this seems to be broken. Tested from psi 0.1 + Username = jlib:jid_to_string({From#jid.user, From#jid.server, ""}), + case mod_barracuda:get_config("jabberd_ban_avatars") of + "true" -> + IQ#iq{type = error, sub_el = [SubEl, ?ERR_FORBIDDEN]}; + _ -> % 'false' or unset/undef/"" + case catch set_vcard(Username, LServer, SubEl) of + ok -> IQ#iq{type = result, sub_el = []}; + {error, forbidden} -> + IQ#iq{type = error, sub_el = [SubEl, ?ERR_FORBIDDEN]}; + {'EXIT', Reason} -> + IQ#iq{type = error, sub_el = [SubEl, ?ERR_INTERNAL_SERVER_ERROR]}; + Error -> + IQ#iq{type = error, sub_el = [SubEl, ?ERR_INTERNAL_SERVER_ERROR]} + end + end; false -> IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]} end; get -> #jid{luser = LUser, lserver = LServer} = To, - Username = ejabberd_odbc:escape(LUser), + FullUsername = jlib:jid_to_string(To), + Username = ejabberd_odbc:escape(FullUsername), case catch ejabberd_odbc:sql_query( LServer, ["select vcard from vcard " - "where username='", Username, "';"]) of + "where username='", FullUsername, "';"]) of {selected, ["vcard"], [{SVCARD}]} -> case xml_stream:parse_element(SVCARD) of {error, _Reason} -> @@ -152,106 +181,86 @@ end end. +% JB: We've changed this so we can support the ability to change the +% photo via standard vCard changes, but block everything else. The way +% do this is to accept the photo change (if any) and save it to the +% database, but ignore all other changes by reconstructing the vCard +% from the entries in the search database. set_vcard(User, LServer, VCARD) -> - FN = xml:get_path_s(VCARD, [{elem, "FN"}, cdata]), - Family = xml:get_path_s(VCARD, [{elem, "N"}, {elem, "FAMILY"}, cdata]), - Given = xml:get_path_s(VCARD, [{elem, "N"}, {elem, "GIVEN"}, cdata]), - Middle = xml:get_path_s(VCARD, [{elem, "N"}, {elem, "MIDDLE"}, cdata]), - Nickname = xml:get_path_s(VCARD, [{elem, "NICKNAME"}, cdata]), - BDay = xml:get_path_s(VCARD, [{elem, "BDAY"}, cdata]), - CTRY = xml:get_path_s(VCARD, [{elem, "ADR"}, {elem, "CTRY"}, cdata]), - Locality = xml:get_path_s(VCARD, [{elem, "ADR"}, {elem, "LOCALITY"},cdata]), - EMail1 = xml:get_path_s(VCARD, [{elem, "EMAIL"}, {elem, "USERID"},cdata]), - EMail2 = xml:get_path_s(VCARD, [{elem, "EMAIL"}, cdata]), - OrgName = xml:get_path_s(VCARD, [{elem, "ORG"}, {elem, "ORGNAME"}, cdata]), - OrgUnit = xml:get_path_s(VCARD, [{elem, "ORG"}, {elem, "ORGUNIT"}, cdata]), - EMail = case EMail1 of - "" -> - EMail2; - _ -> - EMail1 - end, - - LUser = jlib:nodeprep(User), - LFN = stringprep:tolower(FN), - LFamily = stringprep:tolower(Family), - LGiven = stringprep:tolower(Given), - LMiddle = stringprep:tolower(Middle), - LNickname = stringprep:tolower(Nickname), - LBDay = stringprep:tolower(BDay), - LCTRY = stringprep:tolower(CTRY), - LLocality = stringprep:tolower(Locality), - LEMail = stringprep:tolower(EMail), - LOrgName = stringprep:tolower(OrgName), - LOrgUnit = stringprep:tolower(OrgUnit), + PhotoType = xml:get_path_s(VCARD, [{elem, "PHOTO"}, {elem, "TYPE"}, cdata]), + PhotoBase64 = xml:get_path_s(VCARD, [{elem, "PHOTO"}, {elem, "BINVAL"}, + cdata]), if - (LUser == error) or - (LFN == error) or - (LFamily == error) or - (LGiven == error) or - (LMiddle == error) or - (LNickname == error) or - (LBDay == error) or - (LCTRY == error) or - (LLocality == error) or - (LEMail == error) or - (LOrgName == error) or - (LOrgUnit == error) -> - {error, badarg}; + (PhotoType == error) or + (PhotoBase64 == error) -> + {error, forbidden}; true -> - Username = ejabberd_odbc:escape(User), - LUsername = ejabberd_odbc:escape(LUser), - SVCARD = ejabberd_odbc:escape( - lists:flatten(xml:element_to_string(VCARD))), - - 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), + % First, save the photo info + SavePhotoSQL = ["update vcard_search set photo_type = '", + ejabberd_odbc:escape(PhotoType), + "', photo = '", + ejabberd_odbc:escape(PhotoBase64), + "' where username = '", + ejabberd_odbc:escape(User), "';"], + {atomic, ok} = ejabberd_odbc:sql_transaction(LServer, [SavePhotoSQL]), - ejabberd_odbc:sql_transaction( - LServer, - [["delete from vcard where username='", LUsername, "';"], - ["insert into vcard(username, vcard) " - "values ('", LUsername, "', '", SVCARD, "');"], - ["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, "');"]]) + % And reconstruct their vcard based on that change + {atomic, ok} = synchronize_vcard(User, LServer), + ok + end. + +% This synchronizes the user's "vcard" entry with their (canonical) +% vcard_search entry +% NOTE: This needs to stay synchronized with +% Barracuda::UserDatabase::_create_vcard_xml . +synchronize_vcard(User, LServer) -> + case ejabberd_odbc:sql_query(LServer, + ["select fn, family, given, middle, ", + "nickname, bday, ctry, locality, email, ", + "orgname, orgunit, photo, photo_type from vcard_search where ", + "username = '", ejabberd_odbc:escape(User), "'"]) of + {selected, _, [{Fn, Family, Given, Middle, + Nickname, Bday, Ctry, Locality, + Email, Orgname, Orgunit, PhotoBase64, + PhotoType}]} -> + NewVCard = { + xmlelement, "vCard", + [{"xmlns", "vcard-temp"}, + {"prodid", "-//HandGen//NONSGML vGen v1.0//EN"}, + {"version", "2.0"}], + [{xmlelement, "FN", [], [{xmlcdata, Fn}]}, + {xmlelement, "N", [], [ + {xmlelement, "FAMILY", [], [{xmlcdata, Family}]}, + {xmlelement, "GIVEN", [], [{xmlcdata, Given}]}, + {xmlelement, "MIDDLE", [], [{xmlcdata, Middle}]} + ]}, + {xmlelement, "NICKNAME", [], [{xmlcdata, Nickname}]}, + {xmlelement, "BDAY", [], [{xmlcdata, Bday}]}, + {xmlelement, "ADR", [], [ + {xmlelement, "CTRY", [], [{xmlcdata, Ctry}]}, + {xmlelement, "LOCALITY", [], [{xmlcdata, Locality}]} + ]}, + {xmlelement, "EMAIL", [], [ + {xmlelement, "USERID", [], [{xmlcdata, Email}]} + ]}, + {xmlelement, "ORG", [], [ + {xmlelement, "ORGNAME", [], [{xmlcdata, Orgname}]}, + {xmlelement, "ORGUNIT", [], [{xmlcdata, Orgunit}]} + ]}, + {xmlelement, "PHOTO", [], [ + {xmlelement, "TYPE", [], [{xmlcdata, PhotoType}]}, + {xmlelement, "BINVAL", [], [{xmlcdata, PhotoBase64}]} + ]} + ]}, + SNewVCard = lists:flatten(xml:element_to_string(NewVCard)), + PhotoSQL = ["update vcard set vcard ='", + ejabberd_odbc:escape(SNewVCard), + "' where username = '", + ejabberd_odbc:escape(User), "';"], + ejabberd_odbc:sql_transaction(LServer, [PhotoSQL]); + _ -> + {error, unspecified_error} end. -define(TLFIELD(Type, Label, Var), Index: src/mod_barracuda.hrl =================================================================== --- src/mod_barracuda.hrl (.../vendor/ejabberd/1.1.2) (revision 0) +++ src/mod_barracuda.hrl (.../trunk/im/ejabberd) (revision 39233) @@ -0,0 +1,16 @@ +%%% This defines the records used in the Barracuda-specific Mnesia tables. + +% This deliberately mimics the structure of the barracuda configuration +% database, even though this wouldn't really be my first choice of +% structure otherwise. This reduces the impedence mismatch. +-record(config, {variable, scope, scope_data, value}). + +% The calls you can make to ejabberd_mod_barracuda.pl. + +-define(ECHO, 0). +-define(TERMINATE, 1). +-define(RELOAD_CONFIG, 2). +-define(RELOAD_CONFIG_DELAY, 3). +-define(GET_CONFIG_VALUE, 4). +-define(TRANSPORT_PERMITTED, 5). + Index: src/ejabberd_service.erl =================================================================== --- src/ejabberd_service.erl (.../vendor/ejabberd/1.1.2) (revision 39233) +++ src/ejabberd_service.erl (.../trunk/im/ejabberd) (revision 39233) @@ -34,7 +34,7 @@ -include("jlib.hrl"). -record(state, {socket, receiver, streamid, sockmod, - hosts, password, access}). + hosts, password, access, barracuda_access_limited}). %-define(DBGFSM, true). @@ -98,6 +98,10 @@ {value, {_, A}} -> A; _ -> all end, + BarracudaAccessLimited = case lists:keysearch(barracuda_access_limited, 1, Opts) of + {value, {_, B}} -> B; + _ -> false + end, {Hosts, Password} = case lists:keysearch(hosts, 1, Opts) of {value, {_, Hs, HOpts}} -> @@ -124,13 +128,15 @@ end end, ReceiverPid = ejabberd_receiver:start(Socket, SockMod, none), + ?INFO_MSG("Waiting for stream for ~p", [Hosts]), {ok, wait_for_stream, #state{socket = Socket, receiver = ReceiverPid, streamid = new_id(), sockmod = SockMod, hosts = Hosts, password = Password, - access = Access + access = Access, + barracuda_access_limited = BarracudaAccessLimited }}. %%---------------------------------------------------------------------- @@ -200,24 +206,32 @@ NewEl = jlib:remove_attr("xmlns", El), {xmlelement, Name, Attrs, _Els} = NewEl, From = xml:get_attr_s("from", Attrs), - FromJID1 = jlib:string_to_jid(From), - FromJID = case FromJID1 of - #jid{lserver = Server} -> - case lists:member(Server, StateData#state.hosts) of - true -> FromJID1; - false -> error - end; - _ -> error - end, + FromJID = jlib:string_to_jid(From), + % + % NOTE: This is a total hack so file transfer can work. Since + % we are logged in as 'ftbot' we can't just send as some other + % user. This works around and basically makes it wide open. + % + %FromJID1 = jlib:string_to_jid(From), + %FromJID = case FromJID1 of + % #jid{lserver = Server} -> + % case lists:member(Server, StateData#state.hosts) of + % true -> FromJID1; + % false -> error + % end; + % _ -> error + % end, To = xml:get_attr_s("to", Attrs), ToJID = case To of "" -> error; _ -> jlib:string_to_jid(To) end, + AccessBlocked = access_blocked(ToJID, FromJID, StateData), if ((Name == "iq") or (Name == "message") or (Name == "presence")) and - (ToJID /= error) and (FromJID /= error) -> + (ToJID /= error) and (FromJID /= error) and + AccessBlocked == false -> ejabberd_router:route(FromJID, ToJID, NewEl); true -> Err = jlib:make_error_reply(NewEl, ?ERR_BAD_REQUEST), @@ -238,7 +252,23 @@ % TODO {stop, normal, StateData}. - +access_blocked(ToJID, FromJID, StateData) -> + BarracudaAccessLimited = StateData#state.barracuda_access_limited, + case BarracudaAccessLimited of + false -> + false; + true -> + ToJID_String = lists:flatten([ToJID#jid.luser, "@", + ToJID#jid.lserver]), + FromJID_String = lists:flatten([FromJID#jid.luser, "@", + FromJID#jid.lserver]), + Blocked = not mod_barracuda:transport_permitted(hd(StateData#state.hosts), + ToJID_String, + FromJID_String), + % ?INFO_MSG("~p or ~p is blocked: ~p", + % [ToJID_String, FromJID_String, Blocked]), + Blocked + end. %%---------------------------------------------------------------------- %% Func: StateName/3 Index: src/mod_barracuda.erl =================================================================== --- src/mod_barracuda.erl (.../vendor/ejabberd/1.1.2) (revision 0) +++ src/mod_barracuda.erl (.../trunk/im/ejabberd) (revision 39233) @@ -0,0 +1,292 @@ +%%%---------------------------------------------------------------------- +%%% File : mod_barracuda.erl +%%% Author : Jeremy Bowers +%%% Purpose : Integration with the rest of the product +%%%---------------------------------------------------------------------- + +% mod_barracuda does/will do three things: +% * It provides a socket connection on localhost only that can be +% be used to communicate with the Erlang network, to tell it to do +% things like reload the keywords. This is superior to signals +% (almost useless in Erlang) or touching files. +% * It opens a port to a Perl file that allows Ejabberd to directly +% read from the SQL database using standard Barracuda::Config +% functionality, which means we don't have to re-implement it +% in erlang, which is just a bad idea, and can in general interact +% with the rest of the system arbitrarily. +% * It will create mnesia tables independent of any other such tables +% in the system that can be used to modify the behavior of +% ejabberd on the fly, such as for keyword filtering. + +% Therefore, this file will be broken into two parts, the network server +% and the Perl port. + +-module(mod_barracuda). +-author('jbowers@barracuda.com'). + +-behavior(gen_mod). + +-export([start/2, stop/1, + + % Exports for testing + start_barracuda_server/0, + start_port/0, + stop_port/0, + encode/1, + encode_str/1, + + % Exports for people to call into the port remotely + echo/1, + reload_config/0, + get_config/1, + get_config/3, + transport_permitted/3, + + start_config_cache/0, + stop_config_cache/0, + config_cache/2 + ]). + +-include("ejabberd.hrl"). +-include("mod_barracuda.hrl"). + +start(_Host, _Opts) -> + start_barracuda_server(), + start_port(). + +stop(_Host) -> + % FIXME: Can't stop the server (wouldn't want to in real operation anyhow...) + closed = stop_port(). + +%%% +%%% Starting up, start up the TCP server. +%%% + +start_barracuda_server() -> + {ok, Listen} = gen_tcp:listen(9988, + [list, {ip, {127, 0, 0, 1}}, + {packet, 4}, + {active, true}]), + spawn(fun() -> handle_barracuda_connect(Listen) end). + + +handle_barracuda_connect(Listen) -> + {ok, Socket} = gen_tcp:accept(Listen), + spawn(fun () -> handle_barracuda_connect(Listen) end), + handle_barracuda_request(Socket). + +handle_barracuda_request(Socket) -> + receive + {tcp, Socket, Data} -> + case Data of + "reload_keywords" -> + reload_keywords(); + "reload_config" -> + reload_config(); + "reload_config_delay" -> + reload_config_delay(); + _ -> + io:format("Server received unknown request: ~s~n", [Data]), + gen_tcp:send(Socket, lists:flatten([Data, "there"])), + ok = gen_tcp:close(Socket) + end; + {tcp_closed, Socket} -> + io:format("Server socket closed~n") + end. + +%%% +%%% Functions that external programs can access via the socket +%%% + +reload_keywords() -> + % This delay gives the sender time to set up the new data; otherwise + % this tends to get triggered before the files are set up. Since + % I intend to move the keyword loading into a port anyhow, this + % temp hack is OK. + receive + after 1000 -> + true + end, + ?INFO_MSG("Reloading keywords", []), + mod_keyword:reload_regexes(). + +%%% +%%% Start up the perl port +%%% + +start_port() -> + spawn(fun() -> + register(mod_barracuda_port, self()), + process_flag(trap_exit, true), + Port = open_port({spawn, + "/home/im/code/firmware/current/bin/ejabberd_mod_barracuda.pl"}, + [{packet, 4}]), + mod_barracuda_loop(Port) + end). + +stop_port() -> + mod_barracuda_port ! {call, self(), 1, []}, + receive + {mod_barracuda_data, "Terminated"} -> + closed; + Message -> + ?ERROR_MSG("Got message: ~p", [Message]), + error + after 1000 -> + ?ERROR_MSG("Got nothing.", []), + error + end. + +mod_barracuda_loop(Port) -> + receive + {call, Caller, CallNum, Msg} -> + MsgBinary = list_to_binary([<>, encode(Msg), 10]), + Port ! {self(), {command, MsgBinary}}, + receive + {Port, {data, List}} -> + Data2 = list_to_binary(List), + {<>, Data} = split_binary(Data2, 2), + Caller ! {mod_barracuda_data, decode(Type, Data)} + after 5000 -> + ?INFO_MSG("No reply", []), + Caller ! mod_barracuda_error + end, + mod_barracuda_loop(Port); + stop -> + ?INFO_MSG("Stopped port", []), + Port ! {self(), close}, + receive + {Port, closed} -> + exit(normal) + end; + {'EXIT', Port, Reason} -> + ?INFO_MSG("Port terminated", []), + exit({port_terminated, Reason}) + end. + +encode_str(String) -> + String_length = length(String), + list_to_binary([<>, String]). +encode(ParamList) -> + list_to_binary(lists:map(fun encode_str/1, ParamList)). + +% Decode the data... +% 0 -> (byte) string +decode(0, Data) -> + binary_to_list(Data); +% 1 -> int +decode(1, Data) -> + <> = Data, + Int; +decode(2, Data) -> + <> = Data, + case Int of + 0 -> + false; + 1 -> + true + end. + +call(Function, Data) -> + case erlang:whereis(mod_barracuda_port) of + undefined -> + ?INFO_MSG("Restarting mod_barracuda perl port.", []), + start_port(), + % Give it time to start up. + receive + _ -> + ok + after 1000 -> + ok + end; + _Port -> + ok + end, + mod_barracuda_port ! {call, self(), Function, Data}, + receive + {mod_barracuda_data, Result} -> + Result; + mod_barracuda_error -> + mod_barracuda_error + end. + +%%% +%%% Functions you can call in the port +%%% + +echo(Data) -> + call(?ECHO, [Data]). +reload_config() -> + ?INFO_MSG("Reloading configuration", []), + call(?RELOAD_CONFIG, []). +reload_config_delay() -> + ?INFO_MSG("Reloading config in one second", []), + call(?RELOAD_CONFIG_DELAY, []). +get_config(Variable) -> + call(?GET_CONFIG_VALUE, [Variable]). +get_config(Variable, Scope, ScopeData) -> + call(?GET_CONFIG_VALUE, [Variable, Scope, ScopeData]). +transport_permitted(Transport, UserCandidateA, UserCandidateB) -> + Getter = fun () -> + call(?TRANSPORT_PERMITTED, [Transport, UserCandidateA, UserCandidateB]) + end, + config_cache({Transport, UserCandidateA, UserCandidateB}, Getter). + +%%% +%%% Config cache - if we haven't reloaded the config, don't hit +%%% the port, which can take only about 5000 requests per second +%%% on a 620. Using the config cache we seem to get about +%%% 80000-ish a second, which feels much safer. (Plus, without +%%% the cache we're forced to a single proc to run the port. +%%% As long as the port isn't touched, either proc can handle +%%% the cache retrieval.) +%%% + +start_config_cache() -> + spawn(fun() -> + register(mod_barracuda_config_cache, self()), + config_cache_loop_start() + end). + +stop_config_cache() -> + mod_barracuda_config_cache ! 'end'. + +config_cache(Key, Getter) -> + mod_barracuda_config_cache ! {value, self(), Key, Getter}, + receive + {config_value, Value} -> + Value + end. + +% Creates the relevant ets tables; we choose ets because this is +% already clustered at the MySQL level and we don't need to +% cluster it at the Erlang level +config_cache_loop_start() -> + ConfigEts = ets:new(mod_barracuda_config_cache_table, [set, private]), + config_cache_loop(ConfigEts). + +config_cache_loop(ConfigEts) -> + receive + {value, Caller, Key, Getter} -> + case ets:lookup(ConfigEts, Key) of + [{Key, Value}] -> + Caller ! {config_value, Value}; + [] -> + NewValue = Getter(), + ets:insert(ConfigEts, {Key, NewValue}), + Caller ! {config_value, NewValue} + end; + flush_config_cache -> + ets:delete_all_objects(ConfigEts); + 'end' -> + exit("Normal process termination") + end, + config_cache_loop(ConfigEts). + +%%% +%%% Code having to do with Barracuda-specific configuration. +%%% + +initialize_barracuda_mnesia() -> + mnesia:create_table(config, + [{attributes, record_info(fields, config)}]). Index: src/mysql/mysql_conn.beam =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Property changes on: src/mysql/mysql_conn.beam ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Index: src/mysql/mysql_recv.beam =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Property changes on: src/mysql/mysql_recv.beam ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Index: src/mysql/mysql.beam =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Property changes on: src/mysql/mysql.beam ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Index: src/mysql/mysql_auth.beam =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Property changes on: src/mysql/mysql_auth.beam ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Index: src/odbc/ejabberd_odbc.erl =================================================================== --- src/odbc/ejabberd_odbc.erl (.../vendor/ejabberd/1.1.2) (revision 39233) +++ src/odbc/ejabberd_odbc.erl (.../trunk/im/ejabberd) (revision 39233) @@ -34,7 +34,7 @@ -define(STATE_KEY, ejabberd_odbc_state). -define(MAX_TRANSACTION_RESTARTS, 10). --define(MYSQL_PORT, 3306). +-define(MYSQL_PORT, 8001). %%%---------------------------------------------------------------------- %%% API