"This file contains $network and $gopher, for those sites not running the latest lambdacore

Copyright (c) 1992, 1993, Larry Masinter, Erik Ostrom
All Rights Reserved

Permission granted to use this software for non-commercial purposes;
we'd like to be notified of any enhancements, applications, or
bug-fixes in the software.

First:
@create $root_class named Network Utilities
@create $root_class named Gopher Utilities

and then:
@prop #0.network #nnnnn
@prop #0.gopher #mmmmm

with the resulting numbers.
Then load the following script. Finally, set the properties on $network for your
site, as described in 'look $network'.

--------
@prop $network."site" "lambda.parc.xerox.com" r
@prop $network."large_domains" {} r
@prop $network."open_connections" {} r
@prop $network."connect_connections_to" {} r
@prop $network."postmaster" "lambdamoo-registration@parc.xerox.com" r
@prop $network."port" 8888 rc
@prop $network."MOO_name" "LambdaMOO" rc
@prop $network."valid_host_regexp" "^%([-a-z0-9]+%.%)+%(gov%|edu%|com%|org%|int%|mil%|net%|%nato%|arpa%|[a-z][a-z]%)$" rc
@prop $network."maildrop" "sandbox.xerox.com" r
@prop $network."trusts" {} r
@prop $network."reply_address" "moomail@sandbox.xerox.com" r
@prop $network."active" 1 r
@prop $network."valid_email_regexp" "^[-a-z0-9_!.]+$" r
@prop $network."invalid_userids" {} r
;;$network.("invalid_userids") = {"", "sysadmin", "root", "postmaster", "system", "operator", "bin"}
@prop $network."debugging" 0 r
;;$network.("description") = {"Utilities for dealing with network connections", "---------------", "Creating & tracking hosts:", "", ":open(host, port [, connect-connection-to]) => connection", "    open a network connection (using open_network_connection).", "    If 'connect-connection-to' is a player object, the", "    connection will be connected to that object when it", "    gets the first line of input.", "", ":close(connection)", "     closes the connection & cleans up data", "", "------------------", "Parsing network things:", "", ":invalid_email_address(email)", "     return \"\" or string saying why 'email' is invalid.", "     uses .valid_email_regexp", "", ":invalid_hostname(host)", "     return \"\" or string saying why 'host' doesn't look", "     like a valid internet host name", "", ":local_domain(host)", "     returns the 'important' part of a host name, e.g.", "     golden.parc.xerox.com => parc.xerox.com", "", "-------------------", "Sending mail", "", ":sendmail(to, subject, @lines)", "     send mail to the email address 'to' with indicated subject.", "     header fields like 'from', 'date', etc. are filled in.", "     lines can start with additional header lines.", "", ":raw_sendmail(to, @lines)", "     used by :sendmail. Send mail to given user at host, just", "     as specified, no error checking.", "", "================================================================", "Parameters:", "", ".active If 0, disabled sending of mail.", "", ".site   Where does this MOO run?", "        (Maybe MOOnet will use it later).", "", ".port   The network port this MOO listens on.", "", ".large_domains ", "        A list of sites where more than 2 levels of host name are", "        significant, e.g., if you want 'parc.xerox.com' to be", "        different than 'cinops.xerox.com', put \"xerox.com\" as an", "        element in .large_domains.", "", ".postmaster", "        Email address to which problems with MOO mail should", "        go. This should be a real email address that someone reads.", "", ".maildrop", "        Hostname to connect to for dropping off mail. Usually can", "        just be \"localhost\".", "", ".reply_address", "        If a MOO character sends email, where does a reply go?", "        Inserted in 'From:' for mail from characters without", "        registration addresses.        ", "", ".trusts", "        List of (non-wizard) programmers who can call", "        :open, :sendmail, :close", "", "                "}
@verb $network:"parse_address" this none this
@program $network:parse_address
"Given an email address, return {userid, site}.";
"Valid addresses are of the form `userid[@site]'.";
"At least for now, if [@site] is left out, site will be returned as blank.";
"Should be a default address site, or something, somewhere.";
address = args[1];
return (at = index(address, "@")) ? {address[1..at - 1], address[at + 1..length(address)]} | {address, ""};
.

@verb $network:"local_domain" this none this
@program $network:local_domain
"given a site, try to figure out what the `local' domain is.";
"if site has a @ or a % in it, give up and return E_INVARG.";
"blank site is returned as is; try this:local_domain(this.localhost) for the answer you probably want.";
site = args[1];
if (index(site, "@") || index(site, "%"))
  return E_INVARG;
elseif (match(site, "^[0-9.]+$"))
  return E_INVARG;
elseif (!site)
  return "";
elseif (!(dot = rindex(site, ".")))
  dot = rindex(site = this.site, ".");
endif
if ((!dot) || (!(dot = rindex(site[1..dot - 1], "."))))
  return site;
else
  domain = site[dot + 1..length(site)];
  site = site[1..dot - 1];
  while (site && (domain in this.large_domains))
    if (dot = rindex(site, "."))
      domain = tostr(site[dot + 1..length(site)], ".", domain);
      site = site[1..dot - 1];
    else
      return tostr(site, ".", domain);
    endif
  endwhile
  return domain;
endif
.

@verb $network:"open" this none this rx
@program $network:open
":open(address, port, [connect-connection-to])";
"Open a network connection to address/port.  If the connect-connection-to is passed, then the connection will be connected to that object when $login gets ahold of it.  If not, then the connection is just ignored by $login, i.e. not bothered by it with $welcome_message etc.";
"The object specified by connect-connection-to has to be a player (though it need not be a $player).";
"Returns the (initial) connection or an error, as in open_network_connection";
if (!this:trust(caller_perms()))
  return E_PERM;
endif
address = args[1];
port = args[2];
if (length(args) < 3)
  connect_to = $nothing;
elseif ((typeof(connect_to = args[3]) == OBJ) && (valid(connect_to) && is_player(connect_to)))
else
  return E_INVARG;
endif
if (typeof(connection = open_network_connection(address, port)) != ERR)
  this.open_connections = {@this.open_connections, connection};
  if (valid(connect_to))
    this.connect_connections_to = {@this.connect_connections_to, {connection, connect_to}};
  endif
endif
return connection;
.

@verb $network:"close" this none this rx
@program $network:close
if (!this:trust(caller_perms()))
  return E_PERM;
endif
boot_player(args[1]);
$login.ignored = setremove($login.ignored, args[1]);
$network.open_connections = setremove($network.open_connections, args[1]);
if (i = $list_utils:iassoc(args[1], $network.connect_connections_to))
  $network.connect_connections_to = listdelete($network.connect_connections_to, i);
endif
return 1;
.

@verb $network:"sendmail" any none none rxd
@program $network:sendmail
"sendmail(to, subject, line1, line2, ...)";
"  sends mail to internet address 'to', with given subject.";
"  It fills in various fields, such as date, from (from player), etc.";
"  the rest of the arguments are remaining lines of the message, and may begin with additional header fields.";
"  (must match RFC822 specification).";
"Requires $network.trust to call (no anonymous mail from MOO).";
"Returns 0 if successful, or else error condition or string saying why not.";
if (!this:trust(caller_perms()))
  return E_PERM;
endif
mooname = this.MOO_name;
mooinfo = tostr(mooname, " (", this.site, " ", this.port, ")");
if (reason = this:invalid_email_address(to = args[1]))
  return reason;
endif
return this:raw_sendmail(to, "Date: " + ctime(), tostr("From: (", player.name, ") ", tonum(player), "@", this.moo_name, ".moo.mud.org"), "To: " + to, "Subject: " + args[2], "X-Mail-Agent: " + mooinfo, @args[3..length(args)]);
.

@verb $network:"trust" this none this
@program $network:trust
return (who = args[1]).wizard || (who in this.trusts);
.

@verb $network:"init_for_core" this none this
@program $network:init_for_core
if (caller_perms().wizard)
  pass(@args);
  this.active = 0;
  this.reply_address = "moomailreplyto@yourhost";
  this.site = "yoursite";
  this.postmaster = "postmastername@yourhost";
  this.MOO_name = "YourMOO";
  this.maildrop = "localhost";
  this.port = 7777;
  this.large_domains = {};
  this.trusts = {};
  this.open_connections = (this.connect_connections_to = {});
endif
.

@verb $network:"raw_sendmail" any none none rx
@program $network:raw_sendmail
"rawsendmail(to, @lines)";
"sends mail without processing. Returns 0 if successful, or else reason why not.";
if (!caller_perms().wizard)
  return E_PERM;
endif
if (!this.active)
  return "Networking is disabled.";
endif
debugging = this.debugging;
address = args[1];
body = listdelete(args, 1);
data = {"HELO " + this.site, ("MAIL FROM:<" + this.postmaster) + ">", ("RCPT TO:<" + address) + ">", "DATA"};
blank = 0;
for x in (body)
  $command_utils:suspend_if_needed(0);
  if (!(blank || match(x, "[a-z0-9-]*: ")))
    if (x)
      data = {@data, ""};
    endif
    blank = 1;
  endif
  data = {@data, (x == ".") ? "." + x | x};
endfor
data = {@data, ".", "QUIT", ""};
suspend(0);
target = $network:open(this.maildrop, 25);
if (typeof(target) == ERR)
  return tostr("Cannot open connection to maildrop ", this.maildrop, ": ", target);
endif
fork (0)
  for line in (data)
    $command_utils:suspend_if_needed(0);
    if (debugging)
      notify(this.owner, "SEND:" + line);
    endif
    notify(target, line);
  endfor
endfork
expect = {"2", "2", "2", "2", "3", "2"};
while (expect && (typeof(line = read(target)) != ERR))
  if (line)
    if (debugging)
      notify(this.owner, "GET: " + line);
    endif
    if (!index("23", line[1]))
      $network:close(target);
      return line;
      "error return";
    else
      if (line[1] != expect[1])
        expect = {@expect, "2", "2", "2", "2", "2"};
      else
        expect = listdelete(expect, 1);
      endif
    endif
  endif
endwhile
$network:close(target);
return 0;
.

@verb $network:"invalid_email_address" this none this
@program $network:invalid_email_address
"invalid_email_address(email) -- check to see if email looks like a valid email address. Return reason why not.";
address = args[1];
if (!address)
  return "no email address supplied";
endif
if (!(at = rindex(address, "@")))
  return ("'" + address) + "' contains no @";
endif
name = address[1..at - 1];
host = address[at + 1..length(address)];
if (!match(host, $network.valid_host_regexp))
  return tostr("'", host, "' doesn't look like a valid internet host");
endif
if (!match(name, $network.valid_email_regexp))
  return tostr("'", name, "' doesn't look like a valid user name for internet mail");
endif
return "";
.

@verb $network:"invalid_hostname" this none this
@program $network:invalid_hostname
return match(args[1], this.valid_host_regexp) ? "" | tostr("'", args[1], "' doesn't look like a valid internet host name");
.

@verb $network:"email_will_fail" this none this
@program $network:email_will_fail
":email_will_fail(email-address[, display?]) => Makes sure the email-address is one that can actually be used by $network:sendmail().";
reason = this:invalid_email_address(args[1]);
if (reason && {@args, 0}[2])
  player:tell("Invalid email address: ", reason);
endif
return reason;
"following is code from OpalMOO, not used here";
"Possible situations where the address would be unusable are when the address is invalid or we can't connect to the site to send mail.";
"If <display> is true, error messages are displayed to the player and 1 is returned when address is unuable.  If <display> is false and address is unusable, the error message is returned.  If the address is usable, 0 is always returned.";
if (!this:approved_for_network(caller_perms()))
  return E_PERM;
endif
if (!this:valid_email_address(email = args[1]))
  msg = tostr("Your email address (", email, ") is not a usable account.");
elseif ((result = this:verify_email_address(email)) == E_INVARG)
  msg = tostr("Unable to connect to ", this:parse_address(email)[2], ".");
elseif (typeof(result) == STR)
  msg = tostr("The site ", (parse = this:parse_address(email))[2], " does not recognize ", parse[1], " as a valid account.");
else
  return 0;
endif
if ({@args, 0}[2])
  player:tell(msg);
  return 1;
else
  return msg;
endif
"Last modified Tue Jun 15 00:19:01 1993 EDT by Ranma (#200).";
.

@verb $network:"read" this none this
@program $network:read
"useful only for players who own objects that they connect with o_n_c";
if (((this:trust(caller_perms()) && valid(x = args[1])) && (x.owner = caller_perms())) && (x.owner != x))
  return read(x);
else
  return E_PERM;
endif
.

@verb $network:"is_open" this none this rx
@program $network:is_open
":is_open(object)";
"return true if the object is somehow connected, false otherwise.";
return typeof(idle_seconds(@args)) == NUM;
"Relies on test in idle_seconds, and the fact that the verb is !d";
.

"***finished***


@prop $gopher."cache_requests" {} r
@prop $gopher."cache_times" {} r
@prop $gopher."cache_values" {} r
@prop $gopher."limit" 2000 rc
@prop $gopher."cache_timeout" 900 r
;;$gopher.("description") = {"An interface to Gopher internet services.", "Copyright (c) 1992,1993 Grump,JoeFeedback@LambdaMOO.", "", "This object contains just the raw verbs for getting data from gopher servers and parsing the results. Look at #50122 (Generic Gopher Slate) for one example of a user interface. ", "", ":get(site, port, selection)", "  Get data from gopher server: returns a list of strings, or an error if it couldn't connect. Results are cached.", "", ":get_now(site, port, selection)", "  Used by $gopher:get. Arguments are the same: this actually gets the ", "  data without checking the cache. (Don't call this, since the", "  caching is important to reduce lag.)", "  ", ":show_text(who, start, end, site, port, selection)", "  Requires wiz-perms to call.", "  like who:notify_lines($gopher:get(..node..)[start..end])", "", ":clear_cache()", "  Erase the gopher cache.", "", ":parse(string)", "  Takes a directory line as returned by $gopher:get, and return a list", "  {host, port, selector, label}", "   host, port, and selector are what you send to :get.", "  label is a string, where the first character is the type code.", "", ":type(char)", "   returns the name of the gopher type indicated by the character, e.g.", "   $gopher:type(\"I\") => \"image\"", ""}
@verb $gopher:"get_now" this none this rx
@program $gopher:get_now
"Usage:  get_now(site, port, message)";
"Returns a list of strings, or an error if we couldn't connect.";
host = args[1];
port = args[2];
if (!this:trusted(caller_perms()))
  return E_PERM;
elseif ((!match(host, $network.valid_host_regexp)) && (!match(host, "[0-9]+%.[0-9]+%.[0-9]+%.[0-9]+")))
  "allow either welformed internet hosts or explicit IP addresses.";
  return E_INVARG;
elseif (((port != 70) && (port != 80)) && (port < 100))
  "disallow connections to low number ports; necessary?";
  return E_INVARG;
endif
opentime = time();
con = $network:open(args[1], args[2]);
opentime = (time() - opentime);
if (typeof(con) == ERR)
  return con;
endif
notify(con, args[3]);
results = {};
count = this.limit;
"perhaps this isn't necessary, but if a gopher source is slowly spewing things, perhaps we don't want to hang forever -- perhaps this should just fork a process to close the connection instead?";
now = time();
timeout = 30;
end = "^%.$";
if ((length(args) == 4) && (args[4][1] == "2"))
  end = "^[2-9]";
endif
while ((((typeof(string = read(con)) == STR) && (!match(string, end))) && ((count = (count - 1)) > 0)) && ((now + timeout) > (now = time())))
  if (string && (string[1] == "."))
    string = string[2..length(string)];
  endif
  results = {@results, string};
endwhile
$network:close(con);
if (opentime > 0)
  "This is to keep repeated calls to $network:open to 'slow responding hosts' from totally spamming.";
  suspend(0);
endif
return results;
.

@verb $gopher:"parse" this none this
@program $gopher:parse
"parse gopher result line:";
"return {host, port, tag, label}";
"host/port/tag are what you send to the gopher server to get that line";
"label is <type>/human readable entry";
string = args[1];
tab = index(string, "	");
label = string[1..tab - 1];
string = string[tab + 1..length(string)];
tab = index(string, "	");
tag = string[1..tab - 1];
string = string[tab + 1..length(string)];
tab = index(string, "	");
host = string[1..tab - 1];
string = string[tab + 1..length(string)];
tab = index(string, "	");
port = tonum(tab ? string[1..tab - 1] | string);
return {host, port, tag, label};
"ignore extra material after port, if any";
.

@verb $gopher:"show_text" this none this rx
@program $gopher:show_text
"$gopher:show_text(who, start, end, ..node..)";
"like who:notify_lines($gopher:get(..node..)[start..end]), but pipelined";
if (!caller_perms().wizard)
  return E_PERM;
endif
who = args[1];
start = args[2];
end = args[3];
args = args[4..length(args)];
con = $network:open(args[1], args[2]);
if (typeof(con) == ERR)
  player:tell("Sorry, can't get this information now.");
  return;
endif
notify(con, args[3]);
read(con);
"initial blank line";
line = 0;
sent = 0;
end = (end || this.limit);
while (((string = read(con)) != ".") && (typeof(string) == STR))
  line = (line + 1);
  if ((line >= start) && ((!end) || (line <= end)))
    sent = (sent + 1);
    if (valid(who))
      if (string && (string[1] == "."))
        string = string[2..length(string)];
      endif
      who:notify(string);
    else
      notify(who, string);
    endif
  endif
endwhile
$network:close(con);
return sent;
.

@verb $gopher:"type" this none this
@program $gopher:type
type = args[1];
if (type == "1")
  return "menu";
elseif (type == "?")
  return "menu?";
elseif (type == "0")
  return "text";
elseif (type == "7")
  return "search";
elseif (type == "9")
  return "binary";
elseif (type == "2")
  return "phone directory";
elseif (type == "4")
  return "binhex";
elseif (type == "8")
  return "telnet";
elseif (type == "I")
  return "image";
elseif (type == " ")
  "not actually gopher protocol: used by 'goto'";
  return "";
else
  return "unknown";
endif
"not done, need to fill out";
.

@verb $gopher:"summary" this none this
@program $gopher:summary
"return a 'nice' string showing the information in a gopher node";
if (typeof(parse = args[1]) == STR)
  parse = this:parse(parse);
endif
if (parse[1] == "!")
  return {"[remembered set]", "", ""};
endif
if (length(parse) > 3)
  label = parse[4];
  if (label)
    type = $gopher:type(label[1]);
    label = label[2..length(label)];
    if (type == "menu")
    elseif (type == "search")
      label = ((("<" + parse[3][rindex(parse[3], "	") + 1..length(parse[3])]) + "> ") + label);
    else
      label = ((type + ": ") + label);
    endif
  else
    label = "(top)";
  endif
else
  label = (parse[3] + " (top)");
endif
port = "";
if (parse[2] != 70)
  port = tostr(" ", parse[2]);
endif
return {tostr("[", parse[1], port, "]"), label, parse[3]};
.

@verb $gopher:"get" this none this
@program $gopher:get
"Usage: get(site, port, selection)";
"returns a list of strings, or an error if it couldn't connect. Results are cached.";
request = args[1..3];
while ((index = (request in this.cache_requests)) && (this.cache_times[index] > time()))
  if (typeof(result = this.cache_values[index]) != NUM)
    return result;
  endif
  if ($code_utils:task_valid(result))
    "spin, let other process getting same data win, or timeout";
    suspend(1);
  else
    "well, other process crashed, or terminated, or whatever.";
    this.cache_times[index] = 0;
  endif
endwhile
if (!this:trusted(caller_perms()))
  return E_PERM;
endif
while (this.cache_times && (this.cache_times[1] < time()))
  $command_utils:suspend_if_needed(0);
  this.cache_times = listdelete(this.cache_times, 1);
  this.cache_values = listdelete(this.cache_values, 1);
  this.cache_requests = listdelete(this.cache_requests, 1);
  "caution: don't want to suspend between test and removal";
endwhile
$command_utils:suspend_if_needed(0);
this:cache_entry(@request);
value = this:get_now(@args);
$command_utils:suspend_if_needed(0);
index = this:cache_entry(@request);
this.cache_times[index] = (time() + ((typeof(value) == ERR) ? 120 | 1800));
this.cache_values[index] = value;
return value;
.

@verb $gopher:"clear_cache" this none this
@program $gopher:clear_cache
if (!this:trusted(caller_perms()))
  return E_PERM;
endif
if (!args)
  this.cache_values = (this.cache_times = (this.cache_requests = {}));
elseif (index = (args[1..3] in this.cache_requests))
  this.cache_requests = listdelete(this.cache_requests, index);
  this.cache_times = listdelete(this.cache_times, index);
  this.cache_values = listdelete(this.cache_values, index);
endif
.

@verb $gopher:"unparse" this none this
@program $gopher:unparse
"unparse(host, port, tag, label) => string";
host = args[1];
port = args[2];
tag = args[3];
label = args[4];
if (tab = index(tag, "	"))
  "remove search terms from search nodes";
  tag = tag[1..tab - 1];
endif
return tostr(label, "	", tag, "	", host, "	", port);
.

@verb $gopher:"interpret_error" this none this
@program $gopher:interpret_error
"return an explanation for a 'false' $gopher:get result";
value = args[1];
if (value == E_INVARG)
  return "That gopher server is not reachable or is not responding.";
elseif (value == E_QUOTA)
  return "Gopher connections cannot be made at this time because of system resource limitations!";
elseif (typeof(value) == ERR)
  return tostr("The gopher request results in an error: ", value);
else
  return "The gopher request has no results.";
endif
.

@verb $gopher:"trusted" this none this
@program $gopher:trusted
"default -- gopher trusts everybody";
return 1;
.

@verb $gopher:"_textp" this none this
@program $gopher:_textp
"_textp(parsed node)";
"Return true iff the parsed info points to a text node.";
return index("02", args[1][4][1]);
.

@verb $gopher:"_mail_text" this none this
@program $gopher:_mail_text
"_mail_text(parsed node)";
"Return the text to be mailed out for the given node.";
where = args[1];
if (this:_textp(where))
  return $gopher:get(@where);
else
  text = {};
  for x in ($gopher:get(@where))
    parse = $gopher:parse(x);
    sel = parse[4];
    text = {@text, "Type=" + sel[1], "Name=" + sel[2..length(sel)], "Path=" + parse[3], "Host=" + parse[1], "Port=" + tostr(parse[2]), "#"};
  endfor
  return text;
endif
.

@verb $gopher:"init_for_core" this none this
@program $gopher:init_for_core
if (caller_perms().wizard)
  this:clear_cache();
  pass(@args);
endif
.
@verb $gopher:"display_cache" this none none rxd
@program $gopher:display_cache
"Just for debugging -- shows what's in the gopher cache";
req = this.cache_requests;
tim = this.cache_times;
val = this.cache_values;
"save values in case cache changes while printing";
player:tell("size -- expires -- host (port) ------ selector ------------");
for i in [1..length(req)]
  re = req[i];
  host = $string_utils:left(re[1] + ((re[2] == 70) ? "" | tostr(" (", re[2], ")")), 24);
  expires = $string_utils:right($time_utils:dhms(tim[i] - time()), 8);
  va = val[i];
  if (typeof(va) == LIST)
    va = length(va);
  elseif (typeof(va) == ERR)
    va = $error:name(va);
  else
    va = tostr(va);
  endif
  selector = re[3];
  if (length(selector) > 40)
    selector = ("..." + selector[length(selector) - 37..length(selector)]);
  endif
  player:tell($string_utils:right(va, 8), expires, " ", host, selector);
endfor
player:tell("--- end cache display -------------------------------------");
.

@verb $gopher:"get_cache" this none this
@program $gopher:get_cache
"Usage: get_cache(site, port, selection)";
"return current cache";
request = args[1..3];
if (index = (request in this.cache_requests))
  if (this.cache_times[index] > now)
    return this.cache_values[index];
  endif
endif
return 0;
.

@verb $gopher:"cache_entry" this none this
@program $gopher:cache_entry
if (index = (args in this.cache_requests))
  return index;
else
  this.cache_times = {@this.cache_times, time() + 240};
  this.cache_values = {@this.cache_values, task_id()};
  this.cache_requests = {@this.cache_requests, args};
  return length(this.cache_requests);
endif
.

@verb $gopher:"help_msg" this none this
@program $gopher:help_msg
return this:description();
.
"*** finished initializing $gopher ***