"tkMOO-light is Copyright (c) Andrew Wilson 1994,1995,1996,1997,1998,1999
"
"	All Rights Reserved
"
"Permission is hereby granted to use this software for private, academic
"and non-commercial use. No commercial or profitable use of this
"software may be made without the prior permission of the author.
"
"THIS SOFTWARE IS PROVIDED BY ANDREW WILSON ``AS IS'' AND ANY
"EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
"THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
"PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL ANDREW WILSON BE LIABLE
"FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
"CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
"OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
"BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
"WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
"OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
"EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@create $thing named XMCP/1.1 Driver (xdr):XMCP/1.1 Driver (xdr),xdr
@prop xdr."authentication_keys" {} rc
@prop xdr."trusted" {} rc
@prop xdr."debug" 0 rc
@prop xdr."tag" 0 rc
;xdr.("description") = {"A driver for XMCP/1.1 Server->Client messages.  This object implements a message passing system on MOOs that don't have native MCP-like protocol support.", "", "    .trusted = {#owner, #<XMCP Feature Object>, [#<any trusted object>, ...]}"}

@verb xdr:"client_notify" this none this
@program xdr:client_notify
"client_notify(who, request type, keyword/value alist[, lines of data])";
"request type is a string identifying the type of request, e.g. \"ftp\" or \"edit\".  request type must contain no spaces, double-quotes, backslashes, or asterisks.";
"keyword/value alist is a list of pairs {keyword, value}.  Both keyword and value must be strings; keyword must contain no spaces, colons, double-quotes, or backslashes.";
"lines of data is included if this request is to be followed with, yes, lines of data.  Note that not including the data is different from including an empty list as data.";
"caller_perms() must have control over this object...";
"  OR";
"player must have control over caller...";
"  OR";
"caller_perms() are trusted, or permission denied.";
"return E_INVIND if this player doesn't appear to have a smart client (i.e., doesn't have an authentication key set).";
"return E_INVARG if any of the keywords or the request type is bogus.";
who = args[1];
request = args[2];
kv = args[3];
ok = ($perm_utils:controls(caller_perms(), who) || $perm_utils:controls(who, caller)) || (caller_perms() in this.trusted);
if (!ok)
  player:tell("  bad caller[_perms()]");
  return E_PERM;
elseif (this:authentication_key(who) == 0)
  player:tell("  no auth key");
  return E_INVIND;
elseif (match(request, "[ \\\"*]"))
  player:tell("  bad chars in request");
  return E_INVARG;
endif
su = $string_utils;
cu = $command_utils;
keyvals = "";
for keyval in (kv)
  if (match(keyval[1], "[ \\\":]"))
    player:tell("  bad chars in key-vals '", keyval[1], "'");
    return E_INVARG;
  else
    keyvals = tostr(keyvals, keyval[1], ": ", (val = keyval[2]) ? match(val, "[:\" ]") ? su:print(val) | val | "\"\"", " ");
  endif
endfor
if (length(args) == 4)
  tag = this:new_tag();
  keyvals = tostr(keyvals, " tag: ", tag);
  who:tell(tostr("$#$", request, "* ", this:authentication_key(who), " ", keyvals));
  for line in (args[4])
    cu:suspend_if_needed(0);
    who:tell(tostr("$#$data tag: ", tag, " data: ", su:print(line)));
  endfor
  who:tell(tostr("$#$END tag: ", tag));
else
  who:tell(tostr("$#$", request, " ", this:authentication_key(who), " ", keyvals));
endif
return 1;
.

@verb xdr:"authentication_key" this none this
@program xdr:authentication_key
who = args[1];
ok = ($perm_utils:controls(caller_perms(), who) || $perm_utils:controls(who, caller)) || (caller_perms() in this.trusted);
if (!ok)
  player:tell(E_PERM);
  return E_PERM;
endif
akey = $list_utils:assoc(who, this.authentication_keys);
return akey ? akey[2] | 1;
.

@verb xdr:"set_authentication_key" this none this
@program xdr:set_authentication_key
if (i = $list_utils:iassoc(player, this.authentication_keys))
  this.authentication_keys[i] = {player, args[1]};
else
  this.authentication_keys = {{player, args[1]}, @this.authentication_keys};
endif
.

@verb xdr:"challenge" this none this
@program xdr:challenge
ok = ((caller in this.trusted) || $perm_utils:controls(caller_perms(), player)) || (caller_perms() in this.trusted);
if (ok)
  player:tell("$#$xmcp version: 1.1");
endif
return;
.

@verb xdr:"new_tag" this none this
@program xdr:new_tag
this.tag = this.tag + 1;
return this.tag;
.

@verb xdr:"xmcp_aware" this none this
@program xdr:xmcp_aware
":xmcp_aware(who) => 1|0";
"Does this player's client understand XMCP/1.1?";
"o	is their authentication key valid?";
"o	are they using the FO?";
{who} = args;
return this:authentication_key(who) != 1;
.