@create $thing named jabberd:jabberd
@prop $jabberd."users" {} rc
;;$jabberd.("users") = {}
@prop $jabberd."rooms" {} rc
;;$jabberd.("rooms") = {}
@prop $jabberd."debug" #-1 rc
@prop $jabberd."trusted" {} rc
@prop $jabberd."admin" #-1 rc
@prop $jabberd."servers" {} rc
;;$jabberd.("servers") = {}
;;$jabberd.("aliases") = {"jabberd"}
;;$jabberd.("object_size") = {20726, 1013718845}

@verb $jabberd:"get_jabberiqroster" this none this
@program $jabberd:get_jabberiqroster
notify(args[1], "<iq type='set'><query xmlns='jabber:iq:roster'>");
for x in (connected_players())
  notify(args[1], ((("<item jid='" + x.name) + "@"+$network.site+"' name='") + x.name) + "'/>");
endfor
for x in ($jabberd.users)
  if (!(x[2] == #-1))
    notify(args[1], ((("<item jid='" + x[1]) + "@"+$network.site+"' name='") + x[1]) + "'/>");
  endif
endfor
notify(args[1], "</query></iq>");
for x in (connected_players())
  notify(args[1], ("<presence from='" + x.name) + "@"+$network.site+"'> <show>chat</show></presence>");
endfor
for x in ($jabberd.users)
  if (!(x[2] == #-1))
    notify(args[1], ("<presence from='" + x[1]) + "@"+$network.site+"'> <show>chat</show></presence>");
  endif
endfor
.

@verb $jabberd:"parse_line" this none this
@program $jabberd:parse_line
{dude, line} = args;
if (valid(this.debug))
  this.debug:tell((("parse_line: " + tostr(dude)) + " ") + line);
endif
XMLlist = $xml_utils:xml_to_list(line);
{?cmd = "", ?val = ""} = $string_utils:to_list(XMLlist[1][1][1], ":");
cmd = $string_utils:subst(cmd, {{"/", "end"}});
cmd = "resp_" + cmd;
try
  this:(cmd)(dude, XMLlist);
except v (ANY)
  if (valid(this.admin))
     this.admin:tell((("Parse_line failed: " + tostr(dude)) + " ") + line);
  endif
endtry
.

@verb $jabberd:"resp_stream" this none this
@program $jabberd:resp_stream
{dude, XMLlist} = args;
attrs = $list_utils:slice(XMLlist[1], 1);
cs = XMLlist[1]["xmlns" in attrs][2];
if (valid(this.debug))
  this.debug:tell((("Jabber: Stream " + tostr(dude)) + " ") + toliteral(XMLlist));
  this.debug:tell("Jabber: Stream type " + cs);
endif
if (cs == "jabber:client")
  notify(dude, ("<stream:stream from='" + $network.site) + "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/streams'>");
elseif (cs == "jabber:server")
  if (valid(this.debug))
    this.debug:tell(("Jabber: " + tostr(dude)) + " server connection");
  endif
  "id indicates that this is a response, instead of an initial connection";
  if (id = "id" in attrs)
    idv = XMLlist[1][id][2];
    sclist = $list_utils:slice(this.servers, 5);
    "if the player is in the list of servers, verify it, otherwise send new key";
    if (sid = dude in sclist)
      msg = ((((((("<db:verify from='" + $network.site) + "' to='") + this.servers[sid][2]) + "' id='") + tostr(this.servers[sid][3])) + "'>") + this.servers[sid][4]) + "</db:verify>";
    else
      resp = -toint(dude);
      msg = ((("<db:result from='" + $network.site) + "'>") + tostr(resp)) + "</db:result>";
    endif
    notify(dude, msg);
    if (valid(this.debug))
      this.debug:tell("Jabber: Stream Send: " + msg);
    endif
  else
    "This is a first connection, generate an  ID to send back";
    id = random();
    this.servers = {@this.servers, {dude, "", id, "", ""}};
    notify(dude, ((("<stream:stream from='" + $network.site) + "' xmlns='jabber:server' xmlns:stream='http://etherx.jabber.org/streams' xmlns:db='jabber:server:dialback' id='") + tostr(id)) + "'>");
    if (valid(this.debug))
      this.debug:tell((((("Jabber: Stream Send:" + "<stream:stream from='") + $network.site) + "' xmlns='jabber:server' xmlns:stream='http://etherx.jabber.org/streams' xmlns:db='jabber:server:dialback' id='") + tostr(id)) + "'>");
    endif
  endif
else
  if (valid(this.admin))
    this.admin:tell((("Jabber: Invalid stream from: " + tostr(dude)) + " ") + toliteral(XMLlist));
  endif
endif
.

@verb $jabberd:"resp_iq" this none this
@program $jabberd:resp_iq
{dude, XMLlist} = args;
if (valid(this.debug))
  this.debug:tell((("RESP_IQ: " + tostr(dude)) + ":") + toliteral(XMLlist));
endif
query = "";
attrs = $list_utils:slice(XMLlist[1], 1);
type = XMLlist[1]["type" in attrs][2];
elements = $list_utils:slice($list_utils:slice(XMLlist, 1), 1);
if (qpos = "query" in elements)
  qattrs = $list_utils:slice(XMLlist[qpos], 1);
  query = XMLlist[qpos]["xmlns" in qattrs][2];
endif
verb = (type + "_") + $string_utils:subst(query, {{":", ""}, {"'", ""}, {"/", ""}});
if (valid(this.debug))
  this.debug:tell("RESP_IQ: calling:" + verb);
endif
this:(verb)(dude, XMLlist);
.

@verb $jabberd:"resp_presence" this none this
@program $jabberd:resp_presence
{dude, XMLlist} = args;
"no processing of presense yet";
.

@verb $jabberd:"get_jabberiqauth" this none this
@program $jabberd:get_jabberiqauth
{dude, XMLstuff} = args;
notify(dude, "<iq type='result' from='"+$network.site+"'><query xmlns='jabber:client'><desc>Please enter the MOO id of the person you would like to contact.</desc><prompt>Screen Name</prompt></query></iq>");
parms = $list_utils:slice($list_utils:slice(XMLstuff, 1), 1);
upos = "username" in parms;
uname = parms[upos + 1];
if (upos2 = uname in $list_utils:slice(this.users))
  this.users[upos2][2] = dude;
else
  this.users = {@this.users, {uname, dude, {}}};
endif
.

@verb $jabberd:"resp_message" this none this
@program $jabberd:resp_message
{dude, XMLlist} = args;
attrs = $list_utils:slice(XMLlist[1], 1);
type = "message_mail";
if (tpos = "type" in attrs)
  type = "message_" + XMLlist[1][tpos][2];
endif
this:(type)(dude, XMLlist);
.

@verb $jabberd:"get_jabberiqconference" this none this
@program $jabberd:get_jabberiqconference
{dude, XMLlist} = args;
rdude = this:get_rdude(@args);
query = "";
attrs = $list_utils:slice(XMLlist[1], 1);
to = XMLlist[1]["to" in attrs][2];
{?touser = "", ?tohost = ""} = $string_utils:to_list(to, "@");
rooms = $list_utils:slice(this.rooms, 1);
if (rpos = touser in rooms)
  room = this.rooms[rpos][2];
  verb = this.rooms[rpos][3];
  jusers = this.rooms[rpos][4] = setadd(this.rooms[rpos][4], rdude);
  room:(verb)(rdude + " has arrived.");
  this:sendconf("", touser, rdude + " has arrived.");
  if (verb == "announce_all")
    contents = room.contents;
  else
    contents = room.listeners;
  endif
  contents = $set_utils:intersection(contents, {@connected_players(), @this.trusted});
  for x in (contents)
    xmsg = ((((((("<presence to='" + rdude) + "' from='") + touser) + "@") + $network.site) + "/") + x.name) + "'> <show>chat</show></presence>";
    this:send_xml(rdude, xmsg);
  endfor
  for x in (jusers)
    xmsg = ((((((("<presence to='" + rdude) + "' from='") + touser) + "@") + $network.site) + "/") + x) + "'> <show>chat</show></presence>";
    this:send_xml(rdude, xmsg);
  endfor
else
  if (valid(this.admin))
    this.admin:tell("IQCONF: Invalid Room", touser);
  endif
endif
.

@verb $jabberd:"message_chat" this none this
@program $jabberd:message_chat
{dude, XMLlist} = args;
attrs = $list_utils:slice(XMLlist[1], 1);
rdude = rdude = this:get_rdude(@args);
to = XMLlist[1]["to" in attrs][2];
{?touser = "", ?tohost = ""} = $string_utils:to_list(to, "@");
{?tohost = tohost, ?touser = touser} = $string_utils:to_list(tohost, "/");
parms = $list_utils:slice($list_utils:slice(XMLlist, 1), 1);
bpos = "body" in parms;
msg = parms[bpos + 1];
msg = $string_utils:subst(msg, {{"&apos;", "'"}, {"&lt;", "<"}, {"&gt;", ">"}, {"&amp;", "&"}});
if ((tohost == $network.MOO_Name) || (tohost == $network.site))
  if (valid(ldude = $string_utils:match_player(touser)))
    ldude:tell((("Jabber message from " + rdude) + ": ") + msg);
  else
    "Well, if it isn't a MOO user, try jabber users";
    from = ((("from=\"" + rdude) + "@") + $network.site) + "\"";
    type = "type='chat'";
    jusers = $list_utils:slice(this.users);
    if (uno = touser in jusers)
      conn = this.users[uno][2];
      notify(conn, ((((((("<message to='" + to) + "' ") + from) + " ") + type) + "><body>") + msg) + "</body></message>");
    else
      "this is where we return the error to jabber";
      if (valid(this.admin))
         this.admin:tell((((("RM: failed user match touser: " + touser) + " tohost: ") + tohost) + " msg: ") + msg);
      endif
    endif
  endif
else
  from = ("from='" + rdude) + "'";
  type = "type='chat'";
  xmsg = ((((((("<message to='" + to) + "' ") + from) + " ") + type) + "><body>") + msg) + "</body></message>";
  this:send_xml(to, xmsg);
  if (valid(this.debug))
    this.debug:tell((((("RM: remote host match touser: " + touser) + " tohost: ") + tohost) + " msg: ") + msg);
  endif
  "this is where we call SunNet stuff";
endif
.

@verb $jabberd:"message_mail" this none this
@program $jabberd:message_mail
"this should handle mail someday... Until then, it will be like a chat";
{dude, XMLlist} = args;
this:message_chat(dude, XMLlist);
.

@verb $jabberd:"message_groupchat" this none this
@program $jabberd:message_groupchat
{dude, XMLlist} = args;
attrs = $list_utils:slice(XMLlist[1], 1);
rdude = this:get_rdude(@args);
to = XMLlist[1]["to" in attrs][2];
{?touser = "", ?tohost = ""} = $string_utils:to_list(to, "@");
parms = $list_utils:slice($list_utils:slice(XMLlist, 1), 1);
bpos = "body" in parms;
msg = parms[bpos + 1];
msg = $string_utils:subst(msg, {{"&apos;", "'"}, {"&lt;", "<"}, {"&gt;", ">"}, {"&amp;", "&"}});
if ((tohost == $network.MOO_Name) || (tohost == $network.site))
  rooms = $list_utils:slice(this.rooms, 1);
  if (rpos = touser in rooms)
    room = this.rooms[rpos][2];
    verb = this.rooms[rpos][3];
    room:(verb)(((rdude + " says, \"") + msg) + "\"");
  else
    "this is where we return the error to jabber";
    if (valid(this.admin))
       this.admin:tell((((("RMC: failed user match touser: " + touser) + " tohost: ") + tohost) + " msg: ") + msg);
    endif
  endif
else
  if (valid(this.admin))
     this.admin:tell((((("RMC: failed host match touser: " + touser) + " tohost: ") + tohost) + " msg: ") + msg);
  endif
  "this is where we call SunNet stuff";
endif
.

@verb $jabberd:"sendconf" this none this
@program $jabberd:sendconf
{user, conf, msg} = args;
from = ((((("from='" + conf) + "@") + $network.site) + "/") + user) + "'";
type = "type='groupchat'";
xmsg1 = ((("<message " + from) + " ") + type) + " to='";
xmsg2 = ("'><body>" + msg) + "</body></message>";
jusers = $list_utils:slice($jabberd.users);
rooms = $list_utils:slice(this.rooms, 1);
if (rpos = conf in rooms)
  cusers = this.rooms[rpos][4];
  for x in (cusers)
    if (valid(this.debug))
      this.debug:tell((((("sending: " + x) + " ") + xmsg1) + x) + xmsg2);
    endif
    this:send_xml(x, (xmsg1 + x) + xmsg2);
  endfor
else
  if (valid(this.admin))
     this.admin:tell("sendconf: Invalid Room", conf);
  endif
endif
.

@verb $jabberd:"get_jabberiqagents" this none this
@program $jabberd:get_jabberiqagents
"No idea what agents to make available yet";
{dude, XMLList} = args;
.

@verb $jabberd:"get_jabberiqbrowse" this none this
@program $jabberd:get_jabberiqbrowse
{dude, XMLlist} = args;
if (valid(this.debug))
  this.debug:tell((("Getting IQ Browse: " + tostr(dude)) + ":") + toliteral(XMLlist));
endif
attrs = $list_utils:slice(XMLlist[1], 1);
mn = $network.site;
to = XMLlist[1]["to" in attrs][2];
nfrom = ("from='" + to) + "' ";
if (fl = "from" in attrs)
  sto = XMLlist[1][fl][2];
else
  rdude = "unknown";
  rdpos = dude in $list_utils:slice(this.users, 2);
  rdude = this.users[rdpos][1];
  sto = (rdude + "@") + mn;
endif
nto = ("to='" + sto) + "' ";
if (valid(this.debug))
  this.debug:tell((("Getting IQ Browse: to " + tostr(sto)) + ":") + tostr(nto));
endif
sXML = (("<iq " + nfrom) + nto) + "type='result'>";
sXML = ((sXML + "<conference name='") + mn) + " Conferencing Center' type='public' xmlns='jabber:iq:browse'>";
for x in (this.rooms)
  sXML = ((((((sXML + "<conference jid='") + x[1]) + "@") + mn) + "' name='") + x[2]:titlec()) + "' type='public'/>";
endfor
sXML = sXML + "</conference></iq>";
if (valid(this.debug))
  this.debug:tell((("Getting IQ Browse: sending " + tostr(sto)) + ":") + tostr(sXML));
endif
this:send_xml(sto, sXML);
.

@verb $jabberd:"resp_endstream" this none this
@program $jabberd:resp_endstream
{dude, XMLlist} = args;
nn = dude in $list_utils:slice(this.users, 2);
this.users[nn][2] = #-1;
rdude = this.users[nn][1];
for x in (this.users)
  if (!(x[2] == #-1))
    try
      notify(x[2], ("<presence from='" + rdude) + "@"+$network.site+"' type='unavailable'/>");
    except v (ANY)
      nn = x[1] in $list_utils:slice(this.jabberd.users, 1);
      this.users[nn][2] = #-1;
    endtry
  endif
endfor
.

@verb $jabberd:"resp_db" this none this
@program $jabberd:resp_db
{dude, XMLlist} = args;
attrs = $list_utils:slice(XMLlist[1], 1);
if (type = "type" in attrs)
  if (XMLlist[1][type][2] == "'valid'/")
    "Valid response.";
    "Check to see if it came in on a second connection we started";
    sclist = $list_utils:slice(this.servers, 5);
    if (sid = dude in sclist)
      notify(this.servers[sid][1], ((("<db:result from='" + $network.site) + "' to='") + this.servers[sid][2]) + "' type='valid'/>");
      this.servers[sid][3] = "recv";
    else
      "Or if it is on a second connection they started.";
      sclist = $list_utils:slice(this.servers, 1);
      if (sid = dude in sclist)
        notify(this.servers[sid][5], ((("<db:result from='" + $network.site) + "' to='") + this.servers[sid][2]) + "' type='valid'/>");
        this.servers[sid][3] = "send";
      else
        if (valid(this.admin))
          this.admin:tell("Unknown server2 in resp_db.");
        endif
      endif
    endif
  else
    if (valid(this.admin))
      this.admin:tell("Invalid DB response.");
    endif
  endif
else
  "no type was passed.  Assume initial dialback response";
  from = XMLlist[1]["from" in attrs][2];
  if (valid(this.debug))
    this.debug:tell((("Jabber: DB " + tostr(dude)) + " ") + toliteral(XMLlist));
    this.debug:tell("Jabber: DB from: " + from);
  endif
  if (XMLlist[1][1][1] == "db:result")
    "db:result - Send a stream on on the second channel";
    if (sclist = dude in $list_utils:slice(this.servers, 1))
      this.servers[sclist][2] = from;
      netconn = this:connect_server(from, 5269);
      this.servers[sclist][5] = netconn;
      this.servers[sclist][4] = XMLlist[2][1][1];
      notify(netconn, ((("<stream:stream xmlns:stream='http://etherx.jabber.org/streams' xmlns='jabber:server' from='" + $network.site) + "' to='") + from) + "' xmlns:db='jabber:server:dialback'>");
      if (valid(this.debug))
        this.debug:tell((((("Jabber: DB SEND:" + "<stream:stream xmlns:stream='http://etherx.jabber.org/streams' xmlns='jabber:server' from='") + $network.site) + "' to='") + from) + "' xmlns:db='jabber:server:dialback'>");
      endif
    endif
  else
    "db:verify, reply with a valid";
    id = XMLlist[1]["id" in attrs][2];
    reply = XMLlist[2][1][1];
    firstconn = toobj(-toint(reply));
    conns = $list_utils:slice(this.servers, 1);
    to = "unknown";
    if (cpos = firstconn in conns)
      this.servers[cpos][3] = id;
      this.servers[cpos][4] = reply;
      this.servers[cpos][5] = dude;
      to = this.servers[cpos][2];
    endif
    if (valid(this.debug))
      this.debug:tell((((("Resp_db:" + tostr(firstconn)) + " in ") + toliteral(conns)) + " is ") + tostr(cpos));
    endif
    msg = ((((("<db:verify from='" + $network.site) + "' id='") + id) + "' to='") + to) + "' type='valid'/>";
    notify(dude, msg);
    if (valid(this.debug))
      this.debug:tell("Jabber: DB SEND:" + msg);
    endif
  endif
endif
.

@verb $jabberd:"connect_server" this none this
@program $jabberd:connect_server
netconn = $network:open(args[1], args[2]);
if (typeof(netconn) == ERR)
  return E_QUOTA;
endif
set_connection_option(netconn, "binary", 1);
set_connection_option(netconn, "hold-input", 1);
fork (1)
  this:poll(netconn);
endfork
return netconn;
.

@verb $jabberd:"poll" this none this
@program $jabberd:poll
dude = args[1];
while ($network:is_connected(dude))
  try
    msg = this:parse_line(dude, $network:read(dude));
  except v (ANY)
    suspend(0);
  endtry
endwhile
.

@verb $jabberd:"clean_servers" this none this
@program $jabberd:clean_servers
cp = connected_players(1);
srvlist = {};
for x in [1..length(this.servers)]
  if (this.servers[x][1] in cp)
    srvlist = {@srvlist, this.servers[x]};
  else
    try
      $network:close(this.servers[x][5]);
    except v (ANY)
    endtry
  endif
endfor
this.servers = srvlist;
.

@verb $jabberd:"call_server" this none this
@program $jabberd:call_server
rserv = args[1];
netconn = this:connect_server(rserv, 5269);
notify(netconn, ((("<stream:stream xmlns:stream='http://etherx.jabber.org/streams' xmlns='jabber:server' from='" + $network.site) + "' to='") + rserv) + "' xmlns:db='jabber:server:dialback'>");
this.servers = {@this.servers, {netconn, rserv, "", "", ""}};
return netconn;
.

@verb $jabberd:"send_xml" this none this
@program $jabberd:send_xml
{fulluser, XMLmsg} = args;
if (valid(this.debug))
  this.debug:tell((("Sending XML to: " + fulluser) + ":") + toliteral(XMLmsg));
endif
{?user = "", ?host = ""} = $string_utils:to_list(fulluser, "@");
{?host = host, ?res = ""} = $string_utils:to_list(host, "/");
if (valid(this.debug))
  this.debug:tell("Sending XML on host: " + host);
endif
if (((host == "") || (host == $network.site)) || (host == $network.MOO_name))
  jusers = $list_utils:slice(this.users);
  if (uno = user in jusers)
    conn = this.users[uno][2];
  else
    return {0, ("Jabber user " + user) + " not found.  No message sent."};
  endif
else
  "contact remote server here";
  this:clean_servers();
  conn = #-1;
  for x in [1..length(this.servers)]
    if ((this.servers[x][2] == host) && (this.servers[x][3] == "send"))
      conn = this.servers[x][1];
    endif
  endfor
  if (conn == #-1)
    conn = this:call_server(host);
    if (cno = conn in $list_utils:slice(this.servers, 1))
      while (!(this.servers[cno][3] == "send"))
        suspend(1);
      endwhile
    else
      "bad error";
    endif
  endif
endif
try
  notify(conn, XMLmsg);
except v (ANY)
  return {0, "Connection error"};
endtry
return {1, "message sent"};
.

@verb $jabberd:"get_rdude" this none this
@program $jabberd:get_rdude
{dude, XMLlist} = args;
attrs = $list_utils:slice(XMLlist[1], 1);
rdude = "unknown";
if (rdpos = dude in $list_utils:slice(this.users, 2))
  rdude = this.users[rdpos][1];
endif
if (frompos = "from" in attrs)
  rdude = XMLlist[1][frompos][2];
endif
return rdude;
.