gopher.moo Thu July 15, 1993, 9:31PM, Version 1.0 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. This is a general MOO interface to Gopher. To use it, you need a MOO server. The MOO software is available from . In addition, you need some minor changes to the MOO server, so that does not change tabs into spaces on input, and to have open_network_connection enabled. ================================================================ Be sure you're running the server patch (describe dbelow) first! This is a dump of $gopher, the gopher slate, and $network Create three objects @create #1 named Gopher utilities @create $thing named Generic Gopher Slate @create #1 named Network Utilities edit the following script to replace these numbers numbers with the numbers of the three new ones, and then execute it. #11111 == number of Gopher utilities #22222 == number of Generic Gopher Slate #33333 == number of Network Utilities (Note the '@prop #0.gopher #11111' and '@prop #0.network #33333' commands, which set $gopher and $network respectively. You may need to @rmprop #0.network to remove the bogus LambdaCore version.) Fix $network.postmaster, .site, .port, .MOO_name, .large_domains. $network.large_domains = list of network domains such that FOO.name.edu should be considered a separate host than BAR.name.edu. Using the Generic slate, use 'goto host port on generic slate' and 'remember on slate' to set up the default 'top level' menu of new gopher slates. WARNING: The script contains tab characters. Be sure they don't get turned into spaces. ================================================================ Change log: Version 0.1 -- initial release Version 0.2 -- use $network:open instead of raw o_n_c validity check on host names limit on retrievals add (some) documentation to $gopher.room verbs gopher rooms have a remembered set add CSO phone book entries use .desclines property instead of :description (exam won't spam). add gopher lists Version 0.3: change gopher room to portable slate subsumes notes differential cache timeout (shorter for failures) Version 0.4: Include $network in release (Thanks to unattributed JHM programmers) Add 'controlled' state on slate. Slates show headers when they update if watcher isn't controller. Version 0.5: clean up the $network dump some Version 0.6: Version 0.7: very minor patches: more general mailing, hopefully better installation instructions Version 1.0: after port to LambdaMOO, simplify $network, $gopher ================================================================ The patch to allow tabs is in: net_multi.c (not sure if a similar change is necessary in net_single.c) *************** *** 157,161 **** stream_add_char(s, c); else if (c == '\t') ! stream_add_char(s, '\t'); else if (c == proto.eol_in_char) server_receive_line(h->shandle, reset_stream(s)); --- 157,161 ---- stream_add_char(s, c); else if (c == '\t') ! stream_add_char(s, ' '); else if (c == proto.eol_in_char) server_receive_line(h->shandle, reset_stream(s)); ================================================================ @prop #0.gopher #11111 "r" @prop #11111."cache_requests" {} r @prop #11111."cache_times" {} r @prop #11111."cache_values" {} r @prop #11111."limit" 2000 rc @prop #11111."cache_timeout" 900 r ;#11111.("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)", " Like $gopher:get, but bypass the cache (used by $gopher:get).", "", ":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 #11111:"get_now" this none this rx @program #11111: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 read(con); "eliminate blank line"; 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 #11111:"parse" this none this @program #11111: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 /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 #11111:"show_text" this none this rx @program #11111: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 #11111:"type" this none this @program #11111: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 #11111:"summary" this none this @program #11111: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 #11111:"get" this none this @program #11111: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 #11111:"clear_cache" this none this @program #11111: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 #11111:"unparse" this none this @program #11111: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 #11111:"interpret_error" this none this @program #11111: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 #11111:"trusted" this none this @program #11111:trusted "default -- gopher trusts everybody"; return 1; . @verb #11111:"_textp" this none this @program #11111:_textp "_textp(parsed node)"; "Return true iff the parsed info points to a text node."; return index("02", args[1][4][1]); . @verb #11111:"_mail_text" this none this @program #11111:_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 #11111:"init_for_core" this none this @program $gopher:init_for_core if (caller_perms().wizard) this:clear_cache(); pass(@args); endif . @verb #11111:"display_cache" this none none rxd @program #11111: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 #11111:"get_cache" this none this @program #11111: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 #11111:"cache_entry" this none this @program #11111: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 . "***finished loading $gopher*** @prop #22222."value" {} r @prop #22222."stack" {} r @prop #22222."busy" 0 r @prop #22222."remembered" {} r @prop #22222."desclines" {} r @prop #22222."seen" {} r @prop #22222."length" 20 rc @prop #22222."help_msg" {} rc ;#22222.("help_msg") = {"Moving around:", " pick on slate", " select the given menu item (either a number or partial name).", " If it is a text item, it will show it to you.", " on slate", " e.g., 12 on slate. You can omit `pick' when chosing items", " by their number.", " back slate [for n]", " go back up a level; with n supplied, goes back n levels", " reset slate", " reset slate to the default list of `remember'-ed nodes", " goto host [port [path]] on slate", " make a direct jump to a specified host. Please be careful --", " at the moment this slows everyone down if the host isn't valid.", "", "Controlling noise:", " ignore slate", " stop listening when other people fiddle with the slate", " watch slate", " start watching while other people fiddle with the slate", " show slate to person", " show the contents of the slate to someone even if they're not watching", "", "Bookmarks:", " remember [] on slate", " adds item to the default of nodes", " will prompt you for title", " remember on slate", " remembers the current menu choice rather than any ", " particular item", " forget on slate", " (only when looking at the default list)", " deletes the given item", "", "In long menus and text:", " next [] on slate", " prev [] on slate", " move you forward/backward in the set of visible menu items.", " You can give a `number of pages' to move forward.", " read slate", " show you the entire contents of the slate", "", "Miscellaneous:", " stack slate", " show stack, where `back' will go", " details on slate", " show host, port number, and selection string for a given item. ", " mailme slate", " if you have a valid registration address: send mail with the", " slate contents to your email address.", "", "When you first make a gopher slate, you will need to use `goto'", "and then `remember' to set up the default list of nodes."} @prop #22222."locked" 0 r @prop #22222."ignoring" {} r @prop #22222."watching" {} r @prop #22222."controlled" #-1 r @prop #22222."work_with_msg" "%N % to work with %d." rc ;#22222.("description") = "A laptop size computer, with various controls on it." @verb #22222:"p*ick" any on this rxd @program #22222:pick "pick on slate"; " entry is either a line number or an initial substring of a line description"; " select that entry: if it is a menu, go to that node. If it is a search,"; " asks you for the search term & does the search."; " Some kinds of nodes are not implemented."; if (this:_textp() || (!(this.stack || this.remembered))) return player:tell("There's nothing to pick."); endif if (this:busy("picking")) return; endif if (!(which = this:match_choice(dobjstr))) "match_choice took care of it."; this:busy(0); return; endif if ((tostr(tonum(dobjstr)) == dobjstr) && (!({player, @this:_place()} in this.seen))) player:tell($string_utils:pronoun_sub("Oooops, perhaps you should look at the %t first.")); this:busy(0); return; endif parse = $gopher:parse(this.value[which]); desc = this.desclines[which]; this:announce_op("%N % '", desc, "' on the %t."); this:do_pick(@parse); return; . @verb #22222:"reset" this none none rxd @program #22222:reset "reset slate"; " reset the slate to its set of 'remembered' selections"; if (why = this:is_locked(player)) return player:tell($string_utils:pronoun_sub("Sorry, %t seems to be "), why, "."); elseif (this:busy("resetting")) return; endif this:announce_op("%N % the %t."); this.seen = {}; this:set_pointer(); this:busy(0); . @verb #22222:"pop back" any any any rxd @program #22222:pop "back this [by ]"; " move back up the gopher stack to the previous menu"; " or previous N menus."; n = 1; if (iobjstr && (!(iobjstr == tostr(n = tonum(iobjstr))))) return player:tell("Sorry, '", iobjstr, "' doesn't look like a number."); endif if (length(this.stack) < n) player:tell("Sorry, there aren't ", n, " levels to go back."); return; endif if (this:busy("going back")) return; endif this:announce_op("%N % back up ", (n == 1) ? "a level" | tostr(n, " levels"), " on the %t."); this:set_pointer(@this.stack[n + 1..length(this.stack)]); this:busy(0); . @verb #22222:"location_string" this none this rx @program #22222:location_string "location_string([location])"; "A nice-looking version of the location provided, or current location."; loc = ((args && args[1]) || this.stack[1]); where = loc[1]; if (st = loc[4]) "human readable string"; return ((st[2..length(st)] + " (from ") + where) + ")"; return (where + ": ") + st[2..length(st)]; endif if (loc[3]) return ((loc[3] + " (from ") + where) + ")"; return (where + ": ") + loc[3]; endif return where; . @verb #22222:"stack" this none none rxd @program #22222:stack "stack slate"; " show a summary of the gopher stack"; max = 0; if (!this.stack) return player:tell($string_utils:pronoun_sub("%T is at the top level.")); endif for x in (this.stack) max = max(max, length(x[1])); endfor max = (max + 6); for x in ($list_utils:reverse(this.stack)) summary = $gopher:summary(x); player:tell($string_utils:left(summary[1], max), " ", summary[2]); endfor . @verb #22222:"busy" this none this @program #22222:busy "interlock for caching -- mark cache busy or clear; return true of interlock failed"; if (args[1]) if ((args[1] != "reading") && (why = this:is_locked(player))) player:tell($string_utils:pronoun_sub("Sorry, %t seems to be "), why, "."); return 1; endif "make player running this watch it."; this.watching = setadd(this.watching, player); "set busy"; if (this.busy && (this.busy[1] > time())) player:tell("***Sorry, ", this.name, " is busy ", this.busy[2], " for ", this.busy[3], " -- wait a bit."); return 1; else this.busy = {time() + (60 * 5), args[1], player.name, task_id()}; return 0; endif else this.busy = 0; return 0; endif . @verb #22222:"match_choice" this none this @program #22222:match_choice "match_choice(input string)"; "returns the index of the choice, or 0."; "is noisy."; if (this:_textp()) player:tell($string_utils:pronoun_sub("%T is looking at a text node and has no choices.")); return 0; endif input = args[1]; which = $code_utils:tonum(input); len = length(value = this.value); if (typeof(which) == NUM) if ((which < 1) || (which > len)) player:tell("Sorry, ", input, " isn't a number between 1 and ", len, "."); return 0; endif return which; else exact = (partial = {}); for choice in [1..len] valchoice = value[choice][2..index(value[choice], " ") - 1]; if (input == valchoice) exact = {@exact, choice}; elseif (index(valchoice, input) == 1) partial = {@partial, choice}; endif endfor if (length(exact) > 1) player:tell("I'm not sure whether you meant ", $string_utils:english_list(exact, "", " or "), "."); return 0; elseif (exact) return exact[1]; elseif (length(partial) > 1) player:tell("I'm not sure whether you meant ", $string_utils:english_list(partial, "", " or "), "."); return 0; elseif (partial) return partial[1]; else player:tell("Sorry, there is no choice named ", $string_utils:print(input), "."); return 0; endif endif . @verb #22222:"jump goto" any on this rxd @program #22222:jump "goto [socket] on slate"; " given an explicit host name and optional socket, attempt to open a"; " gopher connection to that socket"; words = $string_utils:words(dobjstr); if (!words) player:tell("Usage: ", verb, " [socket]", prepstr ? tostr(" on ", iobjstr) | ""); return; endif host = words[1]; socket = 70; if (length(words) > 1) socket = tonum(words[2]); if (socket < 3) player:tell("The value '", words[2], "' is not a valid socket."); return; endif endif path = ""; if (length(words) > 2) path = dobjstr[(index(dobjstr, words[2]) + length(words[2])) + 1..length(dobjstr)]; endif if (this:busy(tostr("jumping to ", host, " socket ", socket))) return; endif this:announce_op(tostr("%N % to ", host, " socket ", socket, path ? " " | "", path, " on the %t.")); parse = {host, socket, path, "1"}; this:set_pointer(parse, @this:_textp() ? listdelete(this.stack, 1) | this.stack); this:busy(0); . @verb #22222:"details" any on this rxd @program #22222:details if (!(which = this:match_choice(dobjstr))) "match_choice took care of it."; return; endif parse = $gopher:parse(this.value[which]); sel = parse[4]; if (sel) for x in ({"Type=" + sel[1], "Name=" + sel[2..length(sel)], "Path=" + parse[3], "Host=" + parse[1], "Port=" + tostr(parse[2]), "#"}) player:tell(x); endfor else player:tell("**** ERROR, ", which, " is not a valid entry."); endif . @verb #22222:"set_pointer" this none this rx @program #22222:set_pointer if (!args) value = this.remembered; else value = $gopher:get(@args[1]); endif if (!value) this:busy(0); this:announce_op($gopher:interpret_error(value)); return 0; endif if (value[1][1] == "3") this:busy(0); this:announce_op("The gopher request results in an error:"); for x in (value) this:announce_op(": ", x ? x[2..length(x)] | x); endfor return 0; endif if (args && (args[1][4][1] == "0")) "text node"; desc = value; else desc = {}; cnt = 1; for x in (value) $command_utils:suspend_if_needed(0); type = $gopher:type(x[1]); if (type == "text") type = ""; else type = ((" (" + type) + ")"); endif tab = index(x, " "); label = x[2..tab - 1]; desc = {@desc, tostr(cnt, ". ", label, type)}; cnt = (cnt + 1); endfor endif $command_utils:suspend_if_needed(0); this.desclines = desc; this.stack = args; this.value = value; this:busy(0); this:show_results(); return 1; . @verb #22222:"do_pick" this none this @program #22222:do_pick "do_pick(host, port, path, string) -- take parsed output & interact with user as appropriate."; string = args[4]; if ((!string) || index("1?", type = string[1])) "menu"; this:set_pointer(args, @this.stack); elseif (type == "7") player:tell("Search for what? Enter search line or @abort:"); search = read(); if (search != "@abort") this:announce_op("%N % for ", search, " on %t."); this:set_pointer({args[1], args[2], (args[3] + " ") + search, args[4]}, @this.stack); else this:busy(0); this:announce_op("%N % not to search."); endif elseif (type == "3") this:busy(0); this:announce_op("%N chose an error line."); elseif (type == "0") "slates can point at text nodes"; this:set_pointer(args, @this.stack); elseif (type == "2") search = $command_utils:read("one of 'name=' 'phone=' 'email='"); if (!match(search, "[a-z]+=[a-z0-9@-]+")) this:busy(0); player:tell((search == "@abort") ? "No search." | ("Invalid query: " + search)); return; endif this:announce_op("%N % for ", search, " on %t."); this:set_pointer({args[1], args[2], (args[3] + " query ") + search, args[4]}, @this.stack); elseif ($object_utils:has_property(player, "gopher_local") && player.gopher_local) this:busy(0); notify(player, tostr("#$# gopher ", args[1], " ", args[2], " ", args[4], " ", args[3])); else this:busy(0); this:announce_op("Type ", type, " (", $gopher:type(type), ") gopher requests not implemented."); if (type == "8") player:tell("**** telnet ", args[1], (args[2] in {23, 0}) ? "" | (" " + tostr(args[2]))); if (args[3]) player:tell(" log in as: ", args[3]); endif endif endif . @verb #22222:"remember" any on this rxd @program #22222:remember "remember on "; " add the entry (or this menu) to the 'remembered set' for this room."; " use 'remembered' to retrieve the set."; if (!this.stack) return player:tell("Sorry, remembering remembered nodes doesn't work."); endif if (dobjstr == "") parse = this.stack[1]; desc = "the current menu"; elseif (choice = this:match_choice(dobjstr)) parse = $gopher:parse(this.value[choice]); desc = this.desclines[choice]; else "Match_choice took care of it."; return; endif parse[4] = (parse[4][1] + $command_utils:read("description for " + desc)); this.remembered = {@this.remembered, $gopher:unparse(@parse)}; this:announce_op("%N % ", desc, " on the %t as ", parse[4][2..length(parse[4])], "."); . @verb #22222:"forget delete" any on this rxd @program #22222:forget "forget on slate"; " erase an entry from the 'remembered set'"; " only works if you're looking at the 'remembered set'"; if (this.stack) player:tell("You're not looking at the top."); return; endif if (!(choice = this:match_choice(dobjstr))) return; endif this:announce_op("%N % '", this.desclines[choice], "' on the %t."); this.remembered = listdelete(this.remembered, choice); this:set_pointer(); . @verb #22222:"look_self" this none this @program #22222:look_self if (this.stack) sum = $gopher:summary(this.stack[1]); player:tell(this:titlec(), ": ", sum[1], " ", sum[2]); else player:tell(this:titlec()); endif player:tell_lines(this:description()); this:_tell_desc(); state = ""; if (valid(this.controlled)) state = (($string_utils:pronoun_sub("The %t is being controlled by ") + this.controlled:title()) + "."); endif if ((busy = this:_is_busy()) || state) player:tell(state ? state + " " | "", busy ? $string_utils:pronoun_sub(tostr("The %t is busy ", this.busy[2], " for ", this.busy[3], ".")) | ""); endif . @verb #22222:"_tell_desc" this none this @program #22222:_tell_desc who = (args ? args[1] | player); plen = ((length(args) > 1) ? args[2] | this.length); header = ((length(args) > 2) && args[3]); if (this:_textp()) text = this:text(); len = length(text); if ((!plen) || (len <= plen)) $command_utils:suspend_if_needed(0); "6/24/93 change tell_lines to notify_lines to reduce lag."; if (header) who:tell("--------------- ", this.name, "-----"); who:notify_lines(text); who:tell("--------------- ", this.name, "-----"); else who:notify_lines(text); endif return; endif offset = this:offset(); npages = ((len / plen) + 1); thispage = ((offset / plen) + 1); if ((offset != 1) || header) who:tell("--", thispage, " of ", npages, "----- 'prev on ", this.name, "' for previous----"); endif end = ((offset + plen) - 1); who:tell_lines(text[offset..min(len, end)]); if ((len > end) || header) who:tell("--", thispage, " of ", npages, "----- 'next on ", this.name, "' for more --------"); endif return; endif this.seen = setadd(this.seen, {who, @this:_place()}); len = length(this.desclines); if (header) who:tell("--------------- ", this.name, "-----"); endif if (plen && (len > plen)) offset = this:offset(); who:tell_lines(this.desclines[offset..min((offset + this.length) - 1, len)]); nxt = ("next on " + this.name); prv = ("previous on " + this.name); who:tell("---- '", (offset == 1) ? nxt | (((offset + plen) > len) ? prv | (((("'" + nxt) + "' or '") + prv) + "'")), "' to see additional choices (", len, " total) ---"); else who:tell_lines(this.desclines || {$string_utils:pronoun_sub("%T is empty right now.")}); if (header) who:tell("--------------- ", this.name, "-----"); endif endif . @verb #22222:"next prev*ious" any on this rxd @program #22222:next if (this:busy("reading")) "can't 'next' if it is busy"; return; endif this:busy(0); n = (tonum(dobjstr) || 1); if (verb != "next") n = (-n); verb = "previous"; endif offset = this:offset(); new = (offset + (n * this.length)); if (new < 1) if (offset == 1) return player:tell("You're already at the beginning."); else new = 1; endif elseif (new > length(this.desclines)) return player:tell("You're already at the end."); endif this:announce_op("%N % at the ", verb, " ", this:_textp() ? "page" | "results", " on the %t."); this:offset(new); this:show_results(); . @verb #22222:"initialize" this none this @program #22222:initialize if ((caller == this) || $perm_utils:controls(caller_perms(), this)) "don't call this unless you mean it."; this.seen = {}; this.desclines = {}; "The default is that slate's inherit the 'remembered' from their parent. This means, though, that they're initially blank but have to be 'reset' to fire up. See :do_reset"; "this.remembered = {}"; this.busy = 0; this.stack = {}; this.watching = {}; this.controlled = #-1; pass(@args); endif . @verb #22222:"announce_op" this none this @program #22222:announce_op msg = tostr(@args); player:tell($string_utils:pronoun_sub(msg, $you)); if (this.location != player) this.location:announce($string_utils:pronoun_sub(msg)); endif return; "announcing only to watching"; if (watching = setremove($set_utils:intersection(this.watching, this.location:contents()), player)) msg = $string_utils:pronoun_sub(msg); for x in (watching) x:tell(msg); endfor endif . @verb #22222:"_place" this none this @program #22222:_place return this.stack && this.stack[1][1..3]; . @verb #22222:"_textp" this none this @program #22222:_textp return this.stack && index("02", this.stack[1][4][1]); . @verb #22222:"r*ead" any any any rxd @program #22222:read if ((!argstr) || ((dobj == this) && (!prepstr))) this:_tell_desc(player, 0); elseif (which = this:match_choice((($code_utils:short_prep(prepstr) == "on") && (iobj == this)) ? dobjstr | argstr)) where = $gopher:parse(this.value[which]); if (index("02", where[4][1])) this:announce_op("%N % '", this.desclines[which], "' on the %t."); $gopher:show_text(player, 0, 0, @where); player:tell("-------"); else player:tell("Item '", this.desclines[which], "' isn't text and can't be read."); endif else player:tell("Read what?"); endif . @verb #22222:"lock unlock" this none none rxd @program #22222:lock this.locked = (verb == "lock"); this:announce_op("%N %<", $string_utils:lowercase(verb), "s> %t."); . @verb #22222:"text" this none this @program #22222:text return this.value; "don't update slates"; . @verb #22222:"update" this none none rxd @program #22222:update if (this:busy("updating", 1)) return; endif this:announce_op("%N % %t."); if (this.stack) $gopher:clear_cache(@this.stack[1]); endif this:set_pointer(@this.stack); . @verb #22222:"_mail_text" this none this @program #22222:_mail_text if (this:_textp()) return this.value; else text = {}; for x in (this.value) 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 #22222:"show_results" this none this @program #22222:show_results "after a selection is made, this verb is used to show the results; usually to 'player'"; inhere = ($object_utils:isa(this.location, $room) ? this.location:contents() | {player}); for x in (this.watching = setadd(this.watching, player)) $command_utils:suspend_if_needed(0); if (x in inhere) this:_tell_desc(x, this.length, player != x); else this.watching = setremove(this.watching, x); endif endfor . @verb #22222:"ignore watch" this none none rxd @program #22222:ignore was = (player in this.watching); this.watching = ((verb == "watch") ? setadd(this.watching, player) | setremove(this.watching, player)); is = (player in this.watching); if (was == is) player:tell("You already were ", (verb == "watch") ? "watching" | "ignoring", " ", this:title(), "."); elseif (this.location == player) player:tell("You start to ", verb, " ", this:title(), "."); else $you:say_action(("%N % to " + verb) + " %t."); endif . @verb #22222:"show" this to any rxd @program #22222:show if (!valid(iobj)) return player:tell("I don't see '", iobjstr, "' here."); endif $you:say_action("%N % %t to %i."); this:_tell_desc(iobj, this.length, 1); . @verb #22222:"_is_busy" this none this @program #22222:_is_busy if (this.busy) if (this.busy[1] > time()) return 1; else this.busy = 0; endif endif return 0; . @verb #22222:"control" this none none rxd @program #22222:control if (this.controlled == player) player:tell("You are already controlling ", this:title(), "."); return; endif from = (valid(this.controlled) ? (" from " + this.controlled:title()) + "." | "."); if (this.location != player) this.location:announce_all_but({player}, $string_utils:pronoun_sub("%N takes the controls of %t"), from); endif player:tell("You take the controls of ", this:title(), from); this.controlled = player; . @verb #22222:"release" this none none rxd @program #22222:release if (this.controlled == player) $you:say_action("%N % the controls of %t."); this.controlled = #-1; else player:tell("You weren't holding the controls of ", this.name, "."); endif . @verb #22222:"is_locked" this none this @program #22222:is_locked "is this locked?"; if (this.locked) return "locked"; elseif (valid(this.controlled) && (this.controlled != args[1])) if (this.location in {this.controlled, this.controlled.location}) return "controlled by " + this.controlled.name; else this.controlled = #-1; endif endif return 0; . @verb #22222:"match_command" this none this rx @program #22222:match_command "match_command(vrb, dlist, plist, ilist)"; "return true if this object can handle the command, false otherwise"; "vrb - name of the verb the player typed"; "dlist - list of objspecs that this command matches"; "plist and ilist - likewise for prepspecs, iobjspecs"; if ((player.focus_object == this) && (this.location in {player, player.location})) vrb = args[1]; dlist = args[2]; plist = args[3]; ilist = args[4]; if (((vrb in {"pick", "jump", "goto", "details", "remember", "forget", "delete", "next", "prev", "previ", "previo", "previou", "previous"}) && ("none" in plist)) && ("none" in ilist)) return 1; elseif (((vrb in {"read", "ignore", "watch"}) && ("none" in dlist)) && ("none" in plist)) return 1; elseif (((vrb in {"show"}) && ("none" in dlist)) && ("at/to" in plist)) return 1; elseif ((vrb in {"reset", "stack", "mailme", "lock", "unlock", "update", "control", "release"}) && (!("on top of/on/onto/upon" in plist))) return 1; elseif (((vrb in {"pop", "back"}) && ("none" in dlist)) && (("none" in plist) || ("for/about" in plist))) return 1; endif endif return pass(@args); . @verb #22222:"work" none with this r @program #22222:work "This is a JaysHouseMOO verb -- probably doesn't work on other MOOs without a 'focus' object."; if (valid(player:set_focus_object(this))) $you:say_action(this.work_with_msg); else player:tell("You just can't seem to focus on that."); endif . @verb #22222:"mailme" any any any rxd @program #22222:mailme "mailme note"; if ((caller_perms() != player) && (caller != player)) return player:tell("Someone tried to mail you some text, but it didn't work."); endif if (!player.email_address) return player:tell("Sorry, you don't have a registered email address."); endif if ((!argstr) || ((dobj == this) && (!prepstr))) where = this.stack[1]; elseif (which = this:match_choice((($code_utils:short_prep(prepstr) == "on") && (iobj == this)) ? dobjstr | argstr)) where = $gopher:parse(this.value[which]); endif if (where) player:tell("Mailing ", this:location_string(where), " to ", player.email_address, "."); text = $gopher:_mail_text(where); player:tell("... ", length(text), " lines ..."); text = {tostr("(Mail initiated by ", player.name, " (", player, ") connected from ", $string_utils:connection_hostname(connection_name(player)), " using ", this.name, ")"), @text}; suspend(0); result = $network:sendmail(player.email_address, this:location_string(where), @text); if (result == 0) player:tell("Mail sent successfully."); else player:tell("Mail sending error: ", result, "."); endif else player:tell("Sorry, can't mail this."); endif . @verb #22222:"header" this none this @program #22222:header "used by _tell_desc for prefix & suffix lines"; args[1]:tell("------- ", $string_utils:left($string_utils:pronoun_sub(tostr(@listdelete(args, 1), " ")), args[1]:linelen(), "-")); . @verb #22222:"offset" this none this @program #22222:offset if (!this.stack) return 1; endif menu = this.stack[1]; if (args) if (length(menu) > 4) this.stack[1][5] = args[1]; else this.stack[1] = {@{@menu, "", "", "", ""}[1..4], args[1]}; endif elseif (length(menu) > 4) return menu[5]; else return 1; endif . "***finished loading gopher slate *** @prop #0.network #33333 "r" @prop #33333."site" "lambda.parc.xerox.com" r "Change $network.site to your site @prop #33333."large_domains" {} r @prop #33333."open_connections" {} r @prop #33333."connect_connections_to" {} r @prop #33333."postmaster" "lambdamoo-registration@parc.xerox.com" rc "Set $network.postmaster to your email address @prop #33333."port" 8888 rc "Set $network.port to the MOO port number @prop #33333."MOO_name" "LambdaMOO" rc "Set $network.MOO_Name to the name of the MOO @prop #33333."valid_host_regexp" "^%([-a-z0-9]+%.%)+%(gov%|edu%|com%|org%|int%|mil%|net%|%nato%|arpa%|[a-z][a-z]%)$" rc @prop #33333."maildrop" "sandbox.xerox.com" rc @prop #33333."trusts" {} r @prop #33333."reply_address" "moomail@sandbox.xerox.com" rc "set $network.reply_address to return address for mail back to the MOO @prop #33333."active" 1 r @prop #33333."valid_email_regexp" "^[-a-z0-9_!.]+$" rc @prop #33333."invalid_userids" {} r ;#33333.("invalid_userids") = {"", "sysadmin", "root", "postmaster", "system", "operator", "bin"} @prop #33333."debugging" 0 rc ;#33333.("description") = {"Utilities for dealing with network connections", "---------------", "Creating & tracking hosts:", "", ":open(host, port [, connect-connection-to]) => {connection, object}", " open a network connection (using open_network_connection), optionally", " allows for it to be connected to another object.", " (see #0:do_login_command for details).", "", ":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", "", " "} ;#33333.("object_size") = {11843, 741006149} @verb #33333:"parse_address" this none this @program #33333: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 #33333:"local_domain" this none this @program #33333: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 #33333:"open" this none this rx @program #33333: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(forwhom = 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 #33333:"close" this none this rx @program #33333: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 #33333:"sendmail" any none none rxd @program #33333:sendmail "sendmail(to, subject, @lines)"; " sends mail to internet address 'to', with given subject."; " It fills in various fields, such as date, from (from player), etc."; " lines 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(), ((((("From: \"" + player.name) + "@") + mooname) + "\" <") + this.reply_address) + ">", "To: " + to, "Subject: " + args[2], "X-Mail-Agent: " + mooinfo, @args[3..length(args)]); . @verb #33333:"trust" this none this @program #33333:trust return (who = args[1]).wizard || (who in this.trusts); . @verb #33333:"init_for_core" this none this @program #33333: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 #33333:"raw_sendmail" any none none rx @program #33333: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 #33333:"invalid_email_address" this none this @program #33333: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 (!(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 #33333:"invalid_hostname" this none this @program #33333:invalid_hostname return match(args[1], this.valid_host_regexp) ? "" | tostr("'", args[1], "' doesn't look like a valid internet host name"); . "***finished***