;if(!player.wizard && #0.owner != player) line=""; while(line!="\"***Finished***") line=read(player); endwhile player:tell("************"); player:tell("************"); player:tell("In order to install or update SunNET, you must have wizard permissions. Sorry."); player:tell("************"); player:tell("************"); endif ;notify(player,`$sunnet:shutdown()&&1||1!ANY => 0'? "SunNET being updated." | "SunNET being Installed."); ;`$sunnet:remove_protocol("QUERY")!E_VERBNF =>`$sunnet.protocol_handlers=listdelete(tmp=$sunnet.protocol_handlers, $sunnet_utils:iassoc("QUERY",tmp))!ANY''; ;`delete_verb($sunnet_protocols, "QUERY")!ANY'; ;`delete_verb($sunnet, "perform_query")!ANY'; ;`delete_property($sunnet, "querying")!ANY'; ;`delete_property($sunnet, "query_timeout")!ANY'; ;`delete_verb($sunnet_utils, "rot13")!ANY'; ;`delete_property($sunnet_utils, "rot13form")!ANY'; ;`set_verb_info($sunnet_utils, "send", {@(verb_info($sunnet_utils, "send")[1..2]), "verb_call send"})!ANY'; ;`delete_verb($sunnet_link, "SECURE")!ANY'; "********* "sunnet "********* ;`property_info(#0, "sunnet") ! E_PROPNF => add_property(#0, "sunnet", `property_info(#0, "recycler") ! ANY => 0' ? $recycler:_create($generic_utils) | create($generic_utils), {player, "r"})'; ;$sunnet.name = "SunNET"; ;$sunnet.aliases = {"SunNET"}; ;$sunnet.description = {"SunNET is an inter-MOO communications project with design suggestions", "from Samuel Latt Epstein (aka Rocker). All code contained in SunNET was", "written by and is property and copyright of the character known as SunWiz,", "SunWizard, or SunRay on many different MOOs with the exceptions listed.", "Although this code is hereby released as `Freeware', it may /NOT/ be", "distributed unless this copyright information is left intact. Changes", "to SunNET are discouraged and any such changes would be subject to free", "distribution. Any changes should be submitted for inclusion in the main", "distribution. Changes incorporated into the main distribution will be", "acknowledged below.", "", "All Code Copyright 1996-2006, Jason R. Mills (aka SunRay) with the ", "following exceptions:", "---", "$sunnet_admin_fo courtesy stucky@ComMOOnity", "---", "Transfer Tally courtesy Het@World", "---", "Ideas for routing submitted by Samuel Latt Epstein", "---", "@scheduled courtesy of Zephyrus@PolyMOO", "---", "@node & @rpi courtesy of somms@Snow", "---", ":neval*_d submitted by Samuel Latt Epstein", "---", "$sunnet_utils:rrun coutesy Keith@ComMOOnity && wingy@Snow", "---"}; ;$sunnet.r = 1; "PROPS ;`property_info($sunnet, "connection_table") ! E_PROPNF => add_property($sunnet, "connection_table", {}, {player, ""})'; ;`property_info($sunnet, "protocol_handlers") ! E_PROPNF => add_property($sunnet, "protocol_handlers", {}, {player, ""})'; ;`property_info($sunnet, "routes") ! E_PROPNF => add_property($sunnet, "routes", {}, {player, ""})'; ;`property_info($sunnet, "outbound_messages") ! E_PROPNF => add_property($sunnet, "outbound_messages", {}, {player, ""})'; ;`property_info($sunnet, "outbound_task") ! E_PROPNF => add_property($sunnet, "outbound_task", 0, {player, "r"})'; ;`property_info($sunnet, "outbound_connection_info") ! E_PROPNF => add_property($sunnet, "outbound_connection_info", {}, {player, ""})'; ;`property_info($sunnet, "incoming_connection_info") ! E_PROPNF => add_property($sunnet, "incoming_connection_info", {}, {player, ""})'; ;`property_info($sunnet, "active") ! E_PROPNF => add_property($sunnet, "active", 0, {player, "rc"})'; ;`property_info($sunnet, "regenerate_time") ! E_PROPNF => add_property($sunnet, "regenerate_time", 300, {player, "r"})'; ;`property_info($sunnet, "alias_table") ! E_PROPNF => add_property($sunnet, "alias_table", {}, {player, "rc"})'; ;`property_info($sunnet, "bindings") ! E_PROPNF => add_property($sunnet, "bindings", {}, {player, ""})'; ;`property_info($sunnet, "debug_level") ! E_PROPNF => add_property($sunnet, "debug_level", 0, {player, "rc"})'; ;`{property_info($sunnet, "version"), $sunnet.version = "SunNET 4.2.0"} ! E_PROPNF => add_property($sunnet, "version", "SunNET 4.2.0", {player, "rc"})'; ;`property_info($sunnet, "packet_time") ! E_PROPNF => add_property($sunnet, "packet_time", 60, {player, "rc"})'; ;`property_info($sunnet, "counters") ! E_PROPNF => add_property($sunnet, "counters", {}, {player, "rc"})'; ;`property_info($sunnet, "recv_bytes") ! E_PROPNF => add_property($sunnet, "recv_bytes", 0.0, {player, "r"})'; ;`property_info($sunnet, "sent_bytes") ! E_PROPNF => add_property($sunnet, "sent_bytes", 0.0, {player, "r"})'; ;`property_info($sunnet, "IDKeep") ! E_PROPNF => add_property($sunnet, "IDKeep", 100, {player, "r"})'; ;`property_info($sunnet, "ansi_compatible") ! E_PROPNF => add_property($sunnet, "ansi_compatible", 0, {player, "r"})'; ;`property_info($sunnet, "notify_task") ! E_PROPNF => add_property($sunnet, "notify_task", 0, {player, "r"})'; ;`property_info($sunnet, "notify_interval") ! E_PROPNF => add_property($sunnet, "notify_interval", 900, {player, "r"})'; ;`property_info($sunnet, "protocol_table") ! E_PROPNF => add_property($sunnet, "protocol_table", {}, {player, "r"})'; ;`{property_info($sunnet, "script_header"), $sunnet.script_header = {";if(!player.wizard && #0.owner != player) line=\"\"; while(line!=\"\\\"***Finished***\") line=read(player); endwhile player:tell(\"************\"); player:tell(\"************\"); player:tell(\"In order to install or update SunNET, you must have wizard permissions. Sorry.\"); player:tell(\"************\"); player:tell(\"************\"); endif", ";notify(player,`$sunnet:shutdown()&&1||1!ANY => 0'? \"SunNET being updated.\" | \"SunNET being Installed.\");", ";`$sunnet:remove_protocol(\"QUERY\")!E_VERBNF =>`$sunnet.protocol_handlers=listdelete(tmp=$sunnet.protocol_handlers, $sunnet_utils:iassoc(\"QUERY\",tmp))!ANY'';", ";`delete_verb($sunnet_protocols, \"QUERY\")!ANY';", ";`delete_verb($sunnet, \"perform_query\")!ANY';", ";`delete_property($sunnet, \"querying\")!ANY';", ";`delete_property($sunnet, \"query_timeout\")!ANY';", ";`delete_verb($sunnet_utils, \"rot13\")!ANY';", ";`delete_property($sunnet_utils, \"rot13form\")!ANY';", ";`set_verb_info($sunnet_utils, \"send\", {@(verb_info($sunnet_utils, \"send\")[1..2]), \"verb_call send\"})!ANY';", ";`delete_verb($sunnet_link, \"SECURE\")!ANY';", ""}} ! E_PROPNF => add_property($sunnet, "script_header", {";if(!player.wizard && #0.owner != player) line=\"\"; while(line!=\"\\\"***Finished***\") line=read(player); endwhile player:tell(\"************\"); player:tell(\"************\"); player:tell(\"In order to install or update SunNET, you must have wizard permissions. Sorry.\"); player:tell(\"************\"); player:tell(\"************\"); endif", ";notify(player,`$sunnet:shutdown()&&1||1!ANY => 0'? \"SunNET being updated.\" | \"SunNET being Installed.\");", ";`$sunnet:remove_protocol(\"QUERY\")!E_VERBNF =>`$sunnet.protocol_handlers=listdelete(tmp=$sunnet.protocol_handlers, $sunnet_utils:iassoc(\"QUERY\",tmp))!ANY'';", ";`delete_verb($sunnet_protocols, \"QUERY\")!ANY';", ";`delete_verb($sunnet, \"perform_query\")!ANY';", ";`delete_property($sunnet, \"querying\")!ANY';", ";`delete_property($sunnet, \"query_timeout\")!ANY';", ";`delete_verb($sunnet_utils, \"rot13\")!ANY';", ";`delete_property($sunnet_utils, \"rot13form\")!ANY';", ";`set_verb_info($sunnet_utils, \"send\", {@(verb_info($sunnet_utils, \"send\")[1..2]), \"verb_call send\"})!ANY';", ";`delete_verb($sunnet_link, \"SECURE\")!ANY';", ""}, {player, "r"})'; ;`{property_info($sunnet, "script_footer"), $sunnet.script_footer = {";$sunnet_protocols:init_for_core();", ";player:tell(\"SunNET was shutdown. You should verify the installation then call $sunnet:bootstrap() to start it back up.\");", "\"***Finished***"}} ! E_PROPNF => add_property($sunnet, "script_footer", {";$sunnet_protocols:init_for_core();", ";player:tell(\"SunNET was shutdown. You should verify the installation then call $sunnet:bootstrap() to start it back up.\");", "\"***Finished***"}, {player, "r"})'; ;`property_info($sunnet, "portable") ! E_PROPNF => add_property($sunnet, "portable", 0, {player, "r"})'; ;`property_info($sunnet, "bigtime") ! E_PROPNF => add_property($sunnet, "bigtime", 900, {player, "r"})'; ;`property_info($sunnet, "max_age") ! E_PROPNF => add_property($sunnet, "max_age", 0, {player, "r"})'; ;`property_info($sunnet, "technote") ! E_PROPNF => add_property($sunnet, "technote", {}, {player, "rc"})'; ;`property_info($sunnet, "routing_task") ! E_PROPNF => add_property($sunnet, "routing_task", 0, {player, ""})'; ;`property_info($sunnet, "link_language_version") ! E_PROPNF => add_property($sunnet, "link_language_version", 0.0, {player, "r"})'; ;`property_info($sunnet, "changelog") ! E_PROPNF => add_property($sunnet, "changelog", {}, {player, "r"})'; ;`property_info($sunnet, "blocked_sites") ! E_PROPNF => add_property($sunnet, "blocked_sites", {}, {player, ""})'; ;`property_info($sunnet, "banned_sites") ! E_PROPNF => add_property($sunnet, "banned_sites", {}, {player, ""})'; "VERBS ;`verb_info($sunnet, "parse") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "parse"}, {"this", "none", "this"})'; .program $sunnet:parse "SunNET 4.1.0"; ":parse(NUM acknowledge, NUM time, NUM id, LIST path, STR dest, STR proto, ANY message"; "parses the given command for sunnet and determines if the message needs to be routed any further."; if (valid(caller) && parent(caller) == $sunnet_link || caller_perms().wizard) if (!this.active) return; endif {ack, time, id, path, dest, proto, msg} = args; from = path[1]; if (from in this.banned_sites) return "Banned site"; endif this:make_PATH_conjecture(path); if (this.max_age && time < time() - this.max_age) return "This packet is too old."; endif if (tmp = from in $list_utils:slice(this.counters)) lasts = this.counters[tmp][2]; if (id in lasts) return "We have already recieved this packet."; endif lasts = setadd(lasts, id); len = length(lasts); this.counters[tmp][2] = lasts[max(1, len - this.IDKeep)..len]; else this.counters = {@this.counters, {from, {id}}}; endif if ($set_utils:intersection(names = $sunnet_utils.moo_names, path)) return "Message has been here already.. We do not want circles."; endif if (dest in {@names, "GENERAL"} && !(from in this.blocked_sites)) if (tmp = this:get_handler(proto)) rslt = tmp[1]:(tmp[2])(from, proto, msg, path, id, time); else rslt = 0; endif if (!(proto == "ACK" || dest == "GENERAL")) $sunnet_utils:broadcast(from, "ACK", {id, path, time, time(), rslt}); endif endif if (!(dest in $sunnet_utils.moo_names)) $sunnet_utils:sendon(caller, listdelete(args, 1), {$nothing, ""}, {$nothing, ""}); endif else raise(E_PERM); endif "5/29/2005 - Added site security properties"; ""; "Last modified Sun May 29 00:58:18 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "get_handler") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "get_handler"}, {"this", "none", "this"})'; .program $sunnet:get_handler "SunNET 3.0a2"; ":get_handler(STR protocol)"; "=> {obj, verb}"; "What object/verb combination will handle the given protocol."; if (caller_perms().wizard) if (d = $list_utils:assoc(args[1], this.protocol_handlers)) d = listdelete(d, 1); return valid(d[1]) && index(verb_info(d[1], d[2])[2], "x") ? d | 0; else return 0; endif else raise(E_PERM); endif . ;`verb_info($sunnet, "add_protocol") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "add_protocol"}, {"this", "none", "this"})'; .program $sunnet:add_protocol "SunNET 3.0a2"; ":add_protocol(STR protocol, OBJ object, STR verb);"; "Specifies that the verb object:verb should handle the given protocol."; if (caller_perms().wizard) if (i = $list_utils:iassoc(args[1], this.protocol_handlers)) this.protocol_handlers[i] = args; else this.protocol_handlers = {@this.protocol_handlers, args}; endif else raise(E_PERM); endif . ;`verb_info($sunnet, "init_for_core") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "init_for_core"}, {"this", "none", "this"})'; .program $sunnet:init_for_core "SunNET 3.0a2"; if (caller_perms().wizard) this.active = 0; this.outbound_task = 0; this.debug_level = 0; this.regenerate_time = 300; this.packet_time = 60; this.connection_table = {}; this.routes = {}; this.outbound_messages = {}; this.bindings = {}; this.incoming_connection_info = {}; this.alias_table = {}; this.counters = {}; this.outbound_connection_info = {}; this.protocol_handlers = {}; this.recv_bytes = 0.0; this.sent_bytes = 0.0; this.IDKeep = 100; this.notify_task = 0; this.notify_interval = 900; this.bigtime = 900; this.max_age = 0; return pass(@args); else raise(E_PERM); endif "Last modified Mon Oct 8 22:55:48 2001 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "net_") ! E_VERBNF => add_verb($sunnet, {player, "rx", "net_*"}, {"this", "none", "this"})'; .program $sunnet:net_ "SunNET 3.0a2"; ":net_open(STR Site, NUM Port);"; " Opens a connection to site:port, returning the connection object."; ":net_close(OBJ ConObject);"; " Closes the given connection."; ":net_is_open(OBJ ConObject);"; " Determines if the given connection is open."; ":net_notify(OBJ ConObject, STR line);"; " Notifies Line to the given connection (may take other params"; " depending on the server)."; ":new_read(OBJ ConObject);"; " Reads a line from the given connection and returns that line."; if (verb == "net_") raise(E_VERBNF); endif if (caller_perms().wizard) $command_utils:suspend_if_needed(0); verb = verb[5..length(verb)]; if (verb == "open") if ($sunnet_utils:is_lambdacore()) return $network:open(@args); else return open_network_connection(@args); endif elseif (verb == "close" || verb == "boot_player") return boot_player(@args); elseif (verb == "is_open") return typeof(idle_seconds(@args)) != ERR; elseif (verb == "notify") this.sent_bytes = this.sent_bytes + tofloat(value_bytes(args[2])); if (this.ansi_compatible) return notify(args[1], $ansi_utils:delete(args[2])); else return notify(@args); endif elseif (verb == "read") return read(@args); else raise(E_VERBNF); endif else raise(E_PERM); endif "Last modified Thu Apr 4 09:53:57 2002 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "enqueue") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "enqueue"}, {"this", "none", "this"})'; .program $sunnet:enqueue "SunNET 3.0a2"; ":enqueue({STR sites explored, ...}, {OBJ ack handler object, STR verb},"; " {OBJ failure handler object, STR verb}, LIST packet w/ack flag);"; if (caller_perms().wizard) {been, ackhandler, failhandler, packet} = args; {ret, time, id, path, dest, proto, message} = packet; if (dest == "GENERAL" || proto == "ACK") msg = tostr("DATA ", this.link_language_version, " ", toliteral(packet)); for y in (this.bindings) {site, object} = y; this.debug_level && !(site in path) && this.owner:notify(tostr("[bright][blue]OUTPUT[normal] to ", site, ": ", msg)); !(site in path) && this:net_notify(object, msg); endfor {o, v} = ackhandler; if (valid(o)) fork (0) dest == "GENERAL" && o:(v)(id, {}, {}, time); endfork endif else return this:outbound_task(been, ackhandler, failhandler, packet); endif else raise(E_PERM); endif "Last modified Sat Sep 21 21:03:48 2002 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "add_entry") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "add_entry"}, {"this", "none", "this"})'; .program $sunnet:add_entry "SunNET 3.0a2"; if (length(args) != 2) raise(E_ARGS); elseif (!caller_perms().wizard) raise(E_PERM); elseif (typeof(args[1]) != STR || typeof(args[2]) != LIST) raise(E_INVARG); endif reform = 0; args = {@args, time()}; if (i = $list_utils:iassoc(args[1], this.connection_table)) args[2] = $list_utils:sort(args[2]); if (this.connection_table[i][1..2] != args[1..2]) reform = 1; endif this.connection_table[i] = args; else reform = 1; this.connection_table = {@this.connection_table, args}; endif if (reform) this:make_IKNOW_conjecture(@args[1..2]); this:reform_routing_table(); endif "Last modified Tue May 21 11:38:51 2002 CDT by Jhind, #117@Rupert."; . ;`verb_info($sunnet, "remove_entry") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "remove_entry"}, {"this", "none", "this"})'; .program $sunnet:remove_entry "SunNET 3.0a2"; if (length(args) != 1) raise(E_ARGS); elseif (!caller_perms().wizard) raise(E_PERM); elseif (typeof(args[1]) != STR) raise(E_INVARG); endif if (i = $list_utils:iassoc(t = $sunnet_utils:true_name(args[1]), this.connection_table)) check = this.connection_table[i][2]; this.connection_table = listdelete(this.connection_table, i); if (i = $list_utils:iassoc(t, this.alias_table)) this.alias_table = listdelete(this.alias_table, i); endif if (i = $list_utils:iassoc(t, this.protocol_table)) this.protocol_table = listdelete(this.protocol_table, i); endif else check = {}; endif this:reform_routing_table(); for x in (check) if (!this:get_path(x)) this:remove_entry(x); endif endfor . ;`verb_info($sunnet, "reform_routing_table") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "reform_routing_table"}, {"this", "none", "this"})'; .program $sunnet:reform_routing_table "SunNET 3.2"; ":reform_routing_table();"; "Recreates the routing table from the informational entries."; if (caller_perms().wizard) "First, get the list of sites we could possibly know about."; SiteSet = {}; DirectConnections = $list_utils:slice(this.bindings); SiteSet = $list_utils:remove_duplicates($list_utils:flatten(this.connection_table)); "We do not need to know about ourself."; SiteSet = setremove(SiteSet, ThisSite = $sunnet_utils.moo_names[1]); DirectConnections = setremove(DirectConnections, ThisSite); "OldRoutes is kept to preserve timing information"; OldRoutes = this.routes; "compute the paths we may follow."; NewRoutes = {}; for Destination in (SiteSet) PathsToDest = {}; OldR = $list_utils:assoc(Destination, OldRoutes); for Link in (DirectConnections) "timeinfo will contain the old path data or a `fast' entry so any new links will be tested first"; timeinfo = $list_utils:assoc(Link, `listdelete(OldR, 1) ! ANY => {}') || {Link, 0.0, 0, 0, 0}; if (Link == Destination || this:leads_to(Link, Destination)) PathsToDest = setadd(PathsToDest, timeinfo); endif endfor if (PathsToDest) NewRoutes = setadd(NewRoutes, {Destination, @$list_utils:sort_alist(PathsToDest, 2)}); endif endfor this.routes = NewRoutes; return NewRoutes; else raise(E_PERM); endif ""; "ChangeLog:"; "3/31/2002 - Updated variable names, simplified code, added last round-trip time, and changed average round-trip time to an floating point value."; ""; "Last modified Tue May 21 11:39:05 2002 CDT by Jhind, #117@Rupert."; . ;`verb_info($sunnet, "leads_to") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "leads_to"}, {"this", "none", "this"})'; .program $sunnet:leads_to "SunNET 3.0a2"; ":leads_to(STR site1, STR site2 [LIST prechecked sites]);"; "If site1 is not in prechecked sites then Does site1 lead to site2"; if (caller_perms().wizard) {sfrom, sto, ?ignore = {}} = args; if (sfrom in ignore) return 0; endif if (sfrom == sto) return sto in ignore ? 0 | 1; endif if (!ignore && this.routing_task != task_id()) `kill_task(this.routing_task) ! ANY'; this.routing_task = task_id(); cleartask = 1; else cleartask = 0; endif conlist = (t = $list_utils:assoc(sfrom, this.connection_table)) ? t[2] | {}; if (sto in conlist) return 1; else ignore = setadd(ignore, sfrom); for x in (conlist) if (t = this:(verb)(x, sto, ignore)) return t + 1; endif ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endfor endif if (cleartask) this.routing_task = 0; endif return 0; else raise(E_PERM); endif "Last modified Tue May 21 11:16:31 2002 CDT by Jhind, #117@Rupert."; . ;`verb_info($sunnet, "get_path") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "get_path"}, {"this", "none", "this"})'; .program $sunnet:get_path "SunNET 4.1.0"; {site, ?verbose = 0} = args; if (caller_perms().wizard) if (i = $list_utils:iassoc(site, this.routes)) routes = listdelete(this.routes[i], 1); routes = $list_utils:sort_alist(routes, 2); return verbose ? routes | $list_utils:slice(routes); else return {}; endif else raise(E_PERM); endif "5/29/2005 - Added verb security"; ""; "Last modified Sun May 29 01:55:38 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "create_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "create_connection"}, {"this", "none", "this"})'; .program $sunnet:create_connection "SunNET 3.0a2"; if (caller_perms().wizard) if (args[1] == "In") return this:_create_in_connection(@listdelete(args, 1)); elseif (args[1] == "Out") return this:_create_out_connection(@listdelete(args, 1)); else raise(E_INVARG); endif else raise(E_PERM); endif . ;`verb_info($sunnet, "_create_in_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "_create_in_connection"}, {"this", "none", "this"})'; .program $sunnet:_create_in_connection "SunNET 3.0a2"; if (caller_perms().wizard) {site, netpass} = args; who = this:_setup_connection(site, netpass); record = {site, netpass}; if (i = $list_utils:iassoc(site, this.incoming_connection_info)) this.incoming_connection_info[i] = record; else this.incoming_connection_info = {@this.incoming_connection_info, record}; endif return who; else raise(E_PERM); endif . ;`verb_info($sunnet, "_create_out_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "_create_out_connection"}, {"this", "none", "this"})'; .program $sunnet:_create_out_connection "SunNET 3.0a2"; if (caller_perms().wizard) {site, host, port, netpass} = args; who = this:_setup_connection(site, netpass); record = {site, host, port, netpass}; if (i = $list_utils:iassoc(site, this.outbound_connection_info)) this.outbound_connection_info[i] = record; else this.outbound_connection_info = {@this.outbound_connection_info, record}; endif return who; else raise(E_PERM); endif . ;`verb_info($sunnet, "_setup_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "_setup_connection"}, {"this", "none", "this"})'; .program $sunnet:_setup_connection "SunNET 3.0a2"; if (caller_perms().wizard) {site, netpass} = args; if (lcore = $sunnet_utils:is_lambdacore()) who = $player_db:find(tostr("SunNET_", site)); else who = $sunnet_db:find(tostr("CONN|", site)); endif if (!valid(who)) if (lcore) r = $wiz_utils:make_player(tostr("SunNET_", site), "", "SunNET utility player"); who = r[1]; chparent(who, $sunnet_link); else who = create($sunnet_link); set_player_flag(who, 1); who.owner = who; $sunnet_db:insert(tostr("CONN|", site), who); endif endif who.login_key = site; who.net_password = netpass; return who; else raise(E_PERM); endif . ;`verb_info($sunnet, "remove_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "remove_connection"}, {"this", "none", "this"})'; .program $sunnet:remove_connection "SunNET 3.0a2"; if (caller_perms().wizard) {site, netpass} = args; site = $sunnet_utils:true_name(site); this:close_connection(site); this:clear_connection(site); if (i = $list_utils:iassoc(site, this.incoming_connection_info)) if (this.incoming_connection_info[i][2] == netpass) this.incoming_connection_info = listdelete(this.incoming_connection_info, i); else raise(E_PERM); endif elseif (i = $list_utils:iassoc(site, this.outbound_connection_info)) if (this.outbound_connection_info[i][4] == netpass) this.outbound_connection_info = listdelete(this.outbound_connection_info, i); else raise(E_PERM); endif endif if (lcore = $sunnet_utils:is_lambdacore()) who = $player_db:find(tostr("SunNET_", site)); if (valid(who)) if (netpass == who.net_password) $wiz_utils:unset_player(who); $recycler:_recycle(who); else raise(E_PERM); endif endif else who = $sunnet_db:find(k = tostr("CONN|", site)); if (valid(who)) if (netpass == who.net_password) set_player_flag(who, 0); recycle(who); else raise(E_PERM); endif endif $sunnet_db:delete(k); endif else raise(E_PERM); endif . ;`verb_info($sunnet, "connection_object") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "connection_object"}, {"this", "none", "this"})'; .program $sunnet:connection_object "SunNET 3.0a2"; ":connection_object(STR site);"; "=> connection object or $nothing if not connected"; if (caller_perms().wizard) {site} = args; if (typeof(site) != STR) raise(E_INVARG); endif if (i = $list_utils:assoc(site, this.bindings)) return i[2]; else return $nothing; endif else raise(E_PERM); endif . ;`verb_info($sunnet, "connection_name") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "connection_name"}, {"this", "none", "this"})'; .program $sunnet:connection_name "SunNET 3.0a2"; ":connection_name(OBJ connection);"; "=> connection name or \"\" if not connected"; if (caller_perms().wizard) {conobj} = args; if (typeof(conobj) != OBJ) raise(E_INVARG); endif if (i = $list_utils:assoc(conobj, this.bindings, 2)) return i[1]; else return ""; endif else raise(E_PERM); endif . ;`verb_info($sunnet, "open_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "open_connection"}, {"this", "none", "this"})'; .program $sunnet:open_connection "SunNET 4.1.0"; if (this.active && caller_perms().wizard) {site} = args; if (!$list_utils:assoc(site, this.bindings)) if (i = $list_utils:assoc(site, this.outbound_connection_info)) if (islcore = $sunnet_utils:is_lambdacore()) who = $player_db:find(tostr("SunNET_", site)); else who = $sunnet_db:find(tostr("CONN|", site)); endif if (!valid(who)) "Strange Error."; raise(E_INVARG); endif who.off = 0; c = this:net_open(i[2], i[3], who); if (typeof(c) != OBJ) this:regenerate_connection(site, who); return raise(E_INVARG, tostr("Could not open SunNET connection to ", i[1], "!")); endif if (islcore) `res = $login:record_connection(who) ! ANY'; endif this:net_notify(c, tostr("REGISTER ", $sunnet_utils.moo_names[1], " ", i[4])); this:regenerate_connection(site, who); endif endif else raise(E_PERM); endif ""; "ChangeLog:"; "6/10/2005, SunWizard - Allow .off links to reconnect when bootstrapping."; ""; "Last modified Sat Jun 11 17:52:36 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "close_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "close_connection"}, {"this", "none", "this"})'; .program $sunnet:close_connection "SunNET 4.1.0"; if (caller_perms().wizard) what = this:connection_object(args[1]); if (this:net_is_open(what)) this:net_notify(what, "CLOSE"); what.off = 1; $sunnet_scheduler:schedule(3, this, "net_boot_player", {what}); $sunnet_scheduler:schedule(5, this, "clear_connection", args); endif $sunnet_scheduler:schedule(5, this, "clear_connection", args); else raise(E_PERM); endif ""; "ChangeLog:"; "6/10/2005, SunWizard - Allow .off links to reconnect when bootstrapping."; ""; "Last modified Sat Jun 11 18:00:03 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "clear_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "clear_connection"}, {"this", "none", "this"})'; .program $sunnet:clear_connection "SunNET 3.0a2"; if (caller_perms().wizard) {site} = args; su = $sunnet_utils; lu = $list_utils; site = su:true_name(site); while (i = lu:iassoc(site, this.bindings)) this.bindings = listdelete(this.bindings, i); endwhile for x in ($sunnet_db:find_all_keys(tostr("RINFO|", site))) $sunnet_db:delete(x); endfor keep = 0; for x in (setremove(lu:slice(this.bindings), su.moo_names[1])) keep = keep + this:leads_to(x, site); endfor if (!keep) cruft = {}; while (i = lu:iassoc(site, this.connection_table)) cruft = {@cruft, @listdelete(this.connection_table[1], 1)}; this.connection_table = listdelete(this.connection_table, i); endwhile while (i = lu:iassoc(site, this.alias_table)) this.alias_table = listdelete(this.alias_table, i); endwhile for x in (cruft) this:clear_connection(x); endfor endif this:reform_routing_table(); else raise(E_PERM); endif . ;`verb_info($sunnet, "outbound_task") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "outbound_task"}, {"this", "none", "this"})'; .program $sunnet:outbound_task "SunNET 3.0a2"; if (caller_perms().wizard) callerid = task_id(); fork (0) {been, ackhandler, failhandler, packet} = args; {ret, time, id, path, dest, proto, message} = packet; this.outbound_messages = {@this.outbound_messages, {id, task_id(), ackhandler, packet}}; su = $sunnet_utils; lu = $list_utils; dbglvl = this.debug_level; lvl2 = dbglvl >= 2; lvl3 = dbglvl >= 3; w = this.owner; togo = this:get_path(su:true_name(dest)); msg = tostr("DATA ", this.link_language_version, " ", toliteral(packet)); lvl2 && w:notify(tostr("[bright][blue]TOGO[normal] pathways before: ", toliteral(togo))); for y in ({@been, @path}) lvl3 && w:notify(tostr("[bright][blue]REMOVING[normal] possible TOGO element, ", y)); togo = setremove(togo, y); endfor lvl2 && w:notify(tostr("[bright][blue]TOGO[normal] pathways after: ", toliteral(togo))); try while (togo) whereto = togo[1]; dbglvl && w:notify(tostr("[bright][blue]OUTPUT[normal] to ", whereto, ": ", msg)); this:net_notify(this:connection_object(whereto), msg); togo = setremove(togo, whereto); if (rslt = suspend(this.packet_time / (length(togo) + 1))) rslt = rslt[2]; {toid, topath, path, totime, packetresult} = rslt; {o, v} = ackhandler; if (valid(o)) fork (0) "forked to try to prevent out of time errors"; `o:(v)(@rslt) ! ANY'; endfork endif return $code_utils:task_valid(callerid) && resume(callerid, {1, packetresult}); endif this:add_failed(dest, whereto); endwhile "call fail handler."; dbglvl && w:notify(tostr("[bright][blue]OUTPUT FAILED[normal]: ", msg)); {o, v} = failhandler; if (valid(o)) fork (0) "forked to try to prevent out of time errors"; o:(v)(id, {}, {}, time, 0); endfork endif return $code_utils:task_valid(callerid) && resume(callerid, E_NACC); finally if (i = lu:iassoc(id, this.outbound_messages)) this.outbound_messages = listdelete(this.outbound_messages, i); endif endtry endfork r = `suspend() ! ANY'; if (typeof(r) == ERR) raise(r, "Unable to send SunNET packet."); else return r[2]; endif else raise(E_PERM); endif "Last modified Fri Feb 14 15:11:21 2003 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "bootstrap") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "bootstrap"}, {"this", "none", "this"})'; .program $sunnet:bootstrap "SunNET 4.1.0"; if (caller_perms().wizard) this.active = 1; this.counters = {}; this.connection_table = {}; this.alias_table = {}; this.protocol_table = {}; this.routes = {}; this.bindings = {}; this.outbound_messages = {}; for x in (this.outbound_connection_info) fork (0) this:open_connection(x[1]); endfork suspend(0); endfor for x in (this.incoming_connection_info) site = x[1]; fork (0) if (islcore = $sunnet_utils:is_lambdacore()) who = $player_db:find(tostr("SunNET_", site)); else who = $sunnet_db:find(tostr("CONN|", site)); endif if (!valid(who)) "Strange Error."; raise(E_INVARG); endif who.off = 0; endfork endfor `$sunnet_scheduler:kill_task(this.notify_task) ! ANY'; fork (30) this.notify_task = $sunnet_scheduler:schedule_every(this.notify_interval, this, "notify_info", {}); endfork else raise(E_PERM); endif ""; "ChangeLog:"; "6/10/2005, SunWizard - Allow .off links to reconnect when bootstrapping."; ""; "Last modified Sun Jun 12 18:19:16 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "shutdown") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "shutdown"}, {"this", "none", "this"})'; .program $sunnet:shutdown "SunNET 3.0a2"; if (caller_perms().wizard) this.active = 0; `$sunnet_scheduler:kill_task(this.notify_task) ! ANY'; for x in ({@this.outbound_connection_info, @this.incoming_connection_info}) this:close_connection(x[1]); endfor for x in ($sunnet.outbound_messages) `kill_task(x[2]) ! ANY'; endfor this.outbound_messages = {}; this.counters = {}; this.connection_table = {}; this.alias_table = {}; this.protocol_table = {}; this.routes = {}; this.bindings = {}; else raise(E_PERM); endif "Last modified Sat Mar 30 18:05:01 2002 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "reboot") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "reboot"}, {"this", "none", "this"})'; .program $sunnet:reboot "SunNET 3.0a2"; if (caller_perms().wizard) this:shutdown(); suspend(5); this:bootstrap(); else raise(E_PERM); endif . ;`verb_info($sunnet, "validate") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "validate"}, {"this", "none", "this"})'; .program $sunnet:validate "SunNET 4.1.0"; if (caller_perms().wizard) x = 1; while (x <= length(this.bindings)) y = this.bindings[x]; if (!(y[2] in connected_players(1))) this.bindings = listdelete(this.bindings, x); this:clear_connection(y[1]); else x = x + 1; endif endwhile x = 1; while (x <= length(this.connection_table)) ok = 0; for y in (this.bindings) if (this:leads_to(y[1], this.connection_table[x][1])) ok = 1; break y; endif endfor if (ok) x = x + 1; else this:clear_connection(this.connection_table[x][1]); "other connections might be affected!"; x = 1; endif endwhile else raise(E_PERM); endif "5/29/2005 - Added verb security"; ""; "Last modified Sun May 29 01:58:59 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "description") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "description"}, {"this", "none", "this"})'; .program $sunnet:description "SunNET 4.1.0"; d = callers(); d = d[length(d)][2] in {"@mwho", "mwho"} ? {} | pass(@args); d = typeof(d) == LIST ? d | {d}; d = {@d, s = tostr("Status of SunNET ", this.version, " (", this.active ? "" | "in", "active):")}; d = {@d, divider = $string_utils:space(length(s), "=")}; !this.connection_table && (d = {@d, " NONE"}); ilist = {{"Open connections:", "Connected to:"}}; for x in (this.connection_table = $list_utils:sort_alist($sunnet.connection_table)) iknow = x[2]; t = $list_utils:assoc(x[1], this.alias_table); alias = t ? listdelete(t, 1) | {}; astr = tostr(" ", x[1], alias ? tostr(" (", $string_utils:english_list(alias), ")") | ""); bstr = iknow ? $string_utils:english_list(iknow) | ""; ilist = {@ilist, {astr, bstr}}; endfor "Don't indent column headers"; first = 1; "Without indent length"; mx = 43; "With indent length"; mx2 = mx + 2; limit = 78 - mx2; for x in (ilist) {site, iknow} = x; site = $sunnet_utils:linesplit(site, mx - 5); for i in [2..length(site)] site[i] = " " + $string_utils:trim(site[i]); endfor d = {@d, @site[1..$ - 1]}; site = site[$]; more = ""; if (length(iknow) > limit) i = rindex(iknow[1..limit], " "); if (i) more = iknow[i + 1..$]; else i = limit; more = iknow[i..$]; endif iknow = iknow[1..i - 1]; endif d = {@d, tostr($string_utils:left(site, @first ? {mx, " "} | {mx2, " ."}), iknow)}; first = 0; while (more) iknow = more; if (length(iknow) > limit - 3) i = rindex(iknow[1..limit - 3], " "); if (i) more = iknow[i + 1..$]; else i = limit - 3; more = iknow[i..$]; endif iknow = iknow[1..i - 1]; else iknow = more; more = ""; endif d = {@d, tostr($string_utils:space(mx2 + 2), iknow)}; endwhile endfor if (0) #117:debug(d); kill_task(task_id()); endif table = $list_utils:slice(this.bindings); if (this.outbound_connection_info = $list_utils:sort_alist(this.outbound_connection_info)) d = {@d, divider}; d = {@d, "Outbound Physical Connections:"}; i = {}; for x in (this.outbound_connection_info) i = {@i, tostr(" ", x[1], " (", x[1] in table ? "" | "not ", "connected)")}; endfor if (length(i) % 2 != 0) i = {@i, ""}; endif for x in [1..m = length(i) / 2] d = {@d, tostr($string_utils:left(i[x], 38), i[m + x])}; endfor endif if (this.incoming_connection_info = $list_utils:sort_alist(this.incoming_connection_info)) d = {@d, divider}; d = {@d, "Incoming Physical Connections:"}; i = {}; for x in (this.incoming_connection_info) i = {@i, tostr(" ", x[1], " (", x[1] in table ? "" | "not ", "connected)")}; endfor if (length(i) % 2 != 0) i = {@i, ""}; endif for x in [1..m = length(i) / 2] d = {@d, tostr($string_utils:left(i[x], 38), i[m + x])}; endfor endif opening = {}; for x in ($sunnet_scheduler.scheduled_tasks) if (x[12] == $sunnet && x[13] == "open_connection" && x[14]) if (!($list_utils:assoc(x[14][1], opening) || $list_utils:assoc(x[14][1], $sunnet.bindings))) time = x[3] - time(); site = x[14][1]; opening = {@opening, {site, time}}; endif endif endfor if (opening) d = {@d, divider}; d = {@d, "Attempting to open:"}; for x in (opening) if ((t = x[2]) == 0) t = "as soon as possible."; elseif (t < 0) t = tostr(-t, " seconds ago."); else t = tostr("in ", t, " seconds."); endif d = {@d, tostr(" ", x[1], " ", t)}; endfor endif if (m = this.outbound_messages) t = length(m); d = {@d, divider}; if (callers()[$][3].wizard) d = {@d, tostr("Outbound messages (", t, "):")}; i = {}; for x in (m) k = tostr(x[4][6], "(", x[4][4][1], "->", x[4][5], ")"); if (ndx = $list_utils:iassoc(k, i)) i[ndx][2] = i[ndx][2] + 1; else i = {@i, {k, 1}}; endif endfor i = $list_utils:sort_alist(i); if (length(i) % 2 != 0) i = {@i, {"", 0}}; endif for x in [1..m = length(i) / 2] d = {@d, tostr($string_utils:left(tostr(" ", i[x][2], ": ", i[x][1]), 38), @i[m + x][2] ? {" ", i[m + x][2], ": ", i[m + x][1]} | {})}; endfor else d = {@d, tostr("* There ", t == 1 ? "is " | "are ", t, " message", t == 1 ? "" | "s", " waiting to be pushed out on the MOOniverse Network.")}; endif endif d = {@d, divider, tostr("Sent ", $sunnet_utils:english_bytes(this.sent_bytes), ", Received ", $sunnet_utils:english_bytes(this.recv_bytes), "."), divider}; return d; ""; "ChangeLog:"; "3/31/2002, SunWiz - Minor display adjustment"; "5/29/2005, SunWiz - Better wrapping for sites with lots of aliases"; ""; "Last modified Sun May 29 02:23:18 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "regenerate_connection") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "regenerate_connection"}, {"this", "none", "this"})'; .program $sunnet:regenerate_connection "SunNET 3.0a2"; if (caller_perms().wizard) {site, link} = args; if ($list_utils:assoc(site, this.outbound_connection_info)) opening = 0; for x in ($sunnet_scheduler.scheduled_tasks) if (x[12] == $sunnet && x[13] == "open_connection" && x[14] == {site}) opening = 1; endif endfor opening || $sunnet_scheduler:schedule(this.regenerate_time, this, "open_connection", {site}); endif else raise(E_PERM); endif . ;`verb_info($sunnet, "sunnetscript") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "sunnetscript"}, {"this", "none", "this"})'; .program $sunnet:sunnetscript "SunNET 4.2.0"; if (caller_perms().programmer) SpecialVerbs = {{"login", $login, "REGISTER"}}; Objects = {$sunnet, $sunnet_utils, $sunnet_protocols, $sunnet_link, $sunnet_fo, $sunnet_scheduler, $sunnet_pc, $sunnet_db, $sunnet_admin_fo, $sunnet_enc}; ObjPropRef = {"sunnet", "sunnet_utils", "sunnet_protocols", "sunnet_link", "sunnet_fo", "sunnet_scheduler", "sunnet_pc", "sunnet_db", "sunnet_admin_fo", "sunnet_enc"}; ObjParents = {gu = "$generic_utils", gu, gu, "$player", "$feature", gu, "$player", "$generic_db", "$feature", gu}; SpecialProps = {{"version", "script_header", "script_footer"}, {"id_counter", "moo_names"}, {}, {}, {}, {"util_verbs"}, {"rwho_threshold", "rpage_program", "cache_use"}, {}, {}, {}}; ValueProps = {{toliteral($sunnet.version), toliteral($sunnet.script_header), toliteral($sunnet.script_footer)}, {tostr("max(random(`$maxint ! E_PROPNF => ", $maxint, "'), 0)"), "`{$network.moo_name} ! E_PROPNF => {\"unknown\"}'"}, {}, {}, {}, {"{\"schedule\", \"reset_scheduler\", \"kill_task\", \"resume\", \"task_valid\", \"task_info\"}"}, {"60", "{\" who=$string_utils:match_player(who);\", \" if(valid(who))\", \" r=who:receive_page(@data);\", \" if (r == 2)\", \" ret = \", \" {$object_utils:has_callable_verb(who, \\\"page_absent_msg\\\") ? \", \" who:page_absent_msg() | \", \" $string_utils:pronoun_sub(\\\"%n % not currently logged in.\\\", who)};\", \" elseif (r == 0)\", \" ret={who:page_refused_msg()};\", \" else\", \" ret={who:page_echo_msg()};\", \" endif\", \" else\", \" ret={tostr(\\\"No such user as \\\",who,\\\".\\\")};\", \" endif\", \" return ret;\"}", $sunnet_pc.cache_use}, {}, {}, {}}; UpdateProps = {{1, 1, 1}, {0, 0}, {}, {}, {}, {1}, {0, 1, 1}, {}, {}, {}}; SpecialObjects = {$sunnet_db}; lines = this.script_header; for ob in [1..length(Objects)] "Set up variables"; {which, ref, parent, spcProps, SpcPropCalc, Update} = {Objects[ob], ObjPropRef[ob], ObjParents[ob], SpecialProps[ob], ValueProps[ob], UpdateProps[ob]}; lines = {@lines, "\"*********", tostr("\"", ref), "\"*********"}; "Emit code to create the object if it does not exist"; lines = {@lines, tostr(";`property_info(#0, ", tmp = toliteral(ref), ") ! E_PROPNF => add_property(#0, ", tmp, ", `property_info(#0, \"recycler\") ! ANY => 0' ? $recycler:_create(", parent, ") | create(", parent, "), {player, \"r\"})';")}; "set basic properties"; " Name:"; lines = {@lines, tostr(";$", ref, ".name = ", toliteral(which.name), ";")}; " Aliases:"; lines = {@lines, tostr(";$", ref, ".aliases = ", toliteral(which.aliases), ";")}; " Description:"; lines = {@lines, tostr(";$", ref, ".description = ", toliteral(which.description), ";")}; " Readable:"; lines = {@lines, tostr(";$", ref, ".r = ", toliteral(which.r), ";")}; if (!(which in SpecialObjects)) lines = {@lines, "\"PROPS"}; "Emit property information"; for prop in (properties(which)) "Determine how to calculate the initial value"; if (i = prop in spcProps) "Special Property...Get the code to set the property"; val = SpcPropCalc[i]; "should the property be updated even if it already exists?"; upd = Update[i]; else "No update"; upd = 0; nf = 1; "Check :init_for_core for initial value"; for line in (`verb_code(which, "init_for_core", 0, 0) ! E_VERBNF => {}') if (m = match(line, tostr("^ *this.", prop, " = %(.*%);$"))) val = substitute("%1", m); nf = 0; endif ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endfor if (nf) val = {"0", "#-1", "\"\"", "E_NONE", "{}", "0", "0", "0", "0", "0.0"}[typeof(which.(prop)) + 1]; endif endif "Emit code to create property if it does not exist (and update it's value if needed)"; lines = {@lines, tostr(";`", @upd ? {"{"} | {}, "property_info($", ref, ", ", toliteral(prop), ")", @upd ? {", $", ref, ".", prop, " = ", val, "}"} | {}, " ! E_PROPNF => add_property($", ref, ", ", toliteral(prop), ", ", val, ", {player, ", toliteral(property_info(which, prop)[2]), "})';")}; ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endfor endif lines = {@lines, "\"VERBS"}; "Emit verb information and code"; for verb in [1..length(verbs(which))] info = verb_info(which, verb); args = verb_args(which, verb); name = info[$]; if (i = index(name, " ")) name = name[1..i - 1]; endif if (i = index(name, "*")) name = name[1..i - 1]; endif lines = {@lines, tostr(";`verb_info($", ref, ", ", toliteral(name), ") ! E_VERBNF => add_verb($", ref, ", {player, ", toliteral(info[2]), ", ", toliteral(info[3]), "}, ", toliteral(args), ")';")}; lines = {@lines, tostr(".program $", ref, ":", name)}; lines = {@lines, @verb_code(which, verb, 0, 0)}; lines = {@lines, ".", ""}; ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endfor endfor lines = {@lines, "\"Special Verbs"}; for x in (SpecialVerbs) {ref, which, verb} = x; info = verb_info(which, verb); args = verb_args(which, verb); name = info[$]; if (i = index(name, " ")) name = name[1..i - 1]; endif if (i = index(name, "*")) name = name[1..i - 1]; endif lines = {@lines, tostr(";`verb_info($", ref, ", ", toliteral(name), ") ! E_VERBNF => add_verb($", ref, ", {player, ", toliteral(info[2]), ", ", toliteral(info[3]), "}, ", toliteral(args), ")';")}; lines = {@lines, tostr(".program $", ref, ":", name)}; lines = {@lines, @verb_code(which, verb, 0, 0)}; lines = {@lines, "."}; ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endfor lines = {@lines, @this.script_footer}; return lines; else raise(E_PERM, "Get a Progbit, ya bum!"); endif ""; "ChangeLog:"; " 3/ 4/2006 - Added $sunnet_enc for encryption services."; ""; "Last modified Sat Mar 4 03:19:03 2006 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "spool_script") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "spool_script"}, {"this", "none", "this"})'; .program $sunnet:spool_script "SunNET 3.0a2"; ":spool_script(site, port, username, userpass[, connectstyle])"; "Uploads the output of $sunnet:sunnetscript to the moo specified by"; " site and port, connecting as the user specified by username and"; " userpass. connectstyle is a description of how the connection"; " information should be passed to the connection. It is a string"; " which can contain the following directives:"; " %U - Substitute username"; " %P - Substitute userpass"; " %M - Substitute a linebreak"; " The default for connectstyle is \"co %U %P\"."; "Returns a string specifying the success or failure of the installation"; "MAKE SURE that this verb and $sunnet:sunnetscript perform the"; " expected function and that you trust the site from which you"; " run this installation program."; {site, port, user, pass, ?connect = "", ?snuff = 0} = args; if (this.portable) connect = connect || "co %U %P"; if (typeof(site) != STR || typeof(port) != INT || typeof(user) != STR || typeof(pass) != STR || typeof(connect) != STR) return raise(E_INVARG); endif script = this:sunnetscript(); cscript = {}; while (connect) if (I = index(connect, "%M")) c = connect[1..I - 1]; connect[1..I + 1] = ""; else c = connect; connect = ""; endif c = strsub(strsub(c, "%U", user), "%P", pass); cscript = {@cscript, c}; endwhile con = this:net_open(site, port); if (`idle_seconds(con) ! ANY => "n"' != "n") fork (0) for s in (cscript) while (!notify(con, s, 1)) suspend(0); endwhile ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endfor suspend(5); for s in ({@script, "quit", "@quit", "exit", "@exit"}) while (!notify(con, s, 1)) suspend(0); endwhile ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endfor while (`buffered_output_length(con) ! ANY => 0') suspend(1); endwhile endfork try output = {}; while (1) line = read(con); if (snuff) output = {@output, line}; else player:tell(">>> ", line); endif endwhile except (ANY) endtry if (snuff) return {@output, "*************************", "Successfully sent, but unverifiable installation success."}; else return "Successfully sent, but unverifiable installation success."; endif else r = "Connection could not be established."; return snuff ? {r} | r; endif else r = "SunNET is currently in between updates, please try a different moo."; return snuff ? {r} | r; endif . ;`verb_info($sunnet, "make_IKNOW_conjecture") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "make_IKNOW_conjecture"}, {"this", "none", "this"})'; .program $sunnet:make_IKNOW_conjecture "SunNET 3.0a2"; ":make_IKNOW_conjecture(node, iknowinfo)"; " Makes a guess as to how sites in iknowinfo are related to node."; if (caller == this || caller_perms().wizard) {node, iknow} = args; reform = 0; self = $sunnet_utils.moo_names[1]; "if node knows about site"; for x in (iknow) if (x != self) if (i = $list_utils:iassoc(x, this.connection_table)) if (!(node in (tmp = this.connection_table[i][2]))) this.connection_table[i][2] = $list_utils:sort(setadd(tmp, node)); reform = 1; endif else this.connection_table = {@this.connection_table, {x, {node}, time()}}; reform = 1; endif endif endfor else raise(E_PERM); endif . ;`verb_info($sunnet, "make_PATH_conjecture") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "make_PATH_conjecture"}, {"this", "none", "this"})'; .program $sunnet:make_PATH_conjecture "SunNET 3.0a2"; ":make_PATH_conjecture(path)"; " Makes a guess as to how the sites in a path are related."; if (caller == this || caller_perms().wizard) {path} = args; reform = 0; inform = {}; self = $sunnet_utils.moo_names[1]; right = `path[2] ! E_RANGE => self'; if (i = $list_utils:iassoc(path[1], this.connection_table)) if (!(right in this.connection_table[i][2])) this.connection_table[i][2..3] = {$list_utils:sort(setadd(this.connection_table[i][2], right)), time()}; reform = 1; else this.connection_table[i][3] = time(); endif else reform = 1; inform = {path[1]}; this.connection_table = {@this.connection_table, {path[1], {right}, time()}}; endif for i in [2..length(path)] left = path[i - 1]; node = path[i]; right = `path[i + 1] ! E_RANGE => self'; if (node != self) if (i = $list_utils:iassoc(node, this.connection_table)) current = oldcurrent = this.connection_table[i][2]; current = $list_utils:sort(setadd(setadd(current, left), right)); if (current != oldcurrent) reform = 1; this.connection_table[i][2] = current; endif this.connection_table[i][3] = time(); else reform = 1; inform = setadd(inform, node); this.connection_table = {@this.connection_table, {node, $list_utils:sort({left, right}), time()}}; endif endif endfor reform && this:reform_routing_table(); for x in (inform) this:notify_info(x); endfor else raise(E_PERM); endif . ;`verb_info($sunnet, "notify_info") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "notify_info"}, {"this", "none", "this"})'; .program $sunnet:notify_info "SunNET 3.2"; ":notify_info(?Dest=\"GENERAL\")"; "Send information about who we know and our aliases"; "Also sends routable packets to known nodes cause timing infomration to be updated"; if (caller_perms().wizard) {?where = "GENERAL"} = args; $sunnet_utils:broadcast(where, "IKNOW", $list_utils:slice($sunnet.bindings)); if (where == "GENERAL") $sunnet_utils:broadcast(where, "ALIAS", $sunnet_utils.moo_names); $sunnet_utils:broadcast(where, "PROTOS", $list_utils:slice(this.protocol_handlers)); $sunnet_utils:broadcast(where, "RWHO", $sunnet_utils:compile_rwho_list()); endif else raise(E_PERM); endif "Last modified Sun Mar 31 21:10:51 2002 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet, "remove_protocol") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "remove_protocol delete_protocol"}, {"this", "none", "this"})'; .program $sunnet:remove_protocol "SunNET 3.0a2"; ":remove_protocol(PROTO)"; "removes the protocol handler entry for PROTO"; if (caller_perms().wizard) {proto} = args; if (i = $list_utils:iassoc(proto, tmp = this.protocol_handlers)) this.protocol_handlers = listdelete(tmp, i); endif else raise(E_PERM); endif . ;`verb_info($sunnet, "add_failed") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "add_failed"}, {"this", "none", "this"})'; .program $sunnet:add_failed "SunNET 3.2"; ":add_failed(dest, link)"; " Updates the timing information for a packet to Dest along Link to indicate falure"; {dest, fail} = args; if (caller == this || caller_perms().wizard) if (i = $list_utils:iassoc(dest, this.routes)) routes = listdelete(this.routes[i], 1); if (j = $list_utils:iassoc(fail, routes)) routes[j][5] = this.bigtime; routes[j][4] = routes[j][4] + 1; routes[j][3] = routes[j][3] + this.bigtime; routes[j][2] = tofloat(routes[j][3]) / tofloat(routes[j][4]); this.routes[i][2..$] = $list_utils:sort_alist(routes, 2); endif endif else raise(E_PERM); endif return; ""; "ChangeLog:"; "3/31/2002 - Added last round-trip time, and changed average round-trip time to an floating point value."; ""; "Last modified Wed Apr 10 16:57:27 2002 CDT by Jhind, #117@Rupert."; . ;`verb_info($sunnet, "neato_graph") ! E_VERBNF => add_verb($sunnet, {player, "rxd", "neato_graph"}, {"this", "none", "this"})'; .program $sunnet:neato_graph "SunNET 3.2"; ":neato_graph()"; " Returns .DOT format graph data for passing to neato."; " Neato is a part of Graphvis from http://www.research.att.com/sw/tools/graphviz/"; DefLabel = this.active ? tostr(this.version, " network layout: ", ctime()) | tostr(this.version, " is currently inactive"); {?Label = DefLabel, ?Epsilon = 0.0001, ?EdgeLen = 1.5, ?HomeStyle = "filled", ?HomeColor = "grey", ?titlefont = "Arial", ?nodefont = "Arial"} = args; output = {"graph SunNET {"}; output = {@output, tostr(" graph [fontsize=12 label=", toliteral(Label), " epsilon=", Epsilon, " overlap=false fontname=", toliteral(titlefont), "];")}; output = {@output, tostr(" node [fontsize=10 fontname=", toliteral(nodefont), "];")}; output = {@output, tostr(" edge [len=", EdgeLen, "];")}; output = {@output, tostr(" ", $sunnet_utils.moo_names[1], " [style=", toliteral(HomeStyle), " color=", toliteral(HomeColor), "];")}; edges = {}; for site in (this.connection_table) {name, connected, time} = site; name = $sunnet_utils:true_name(name); for con in (connected) con = $sunnet_utils:true_name(con); if (RouteData = $list_utils:assoc(name, this.routes)) if (con < name) edges = setadd(edges, {con, name, name, RouteData[2][2]}); else edges = setadd(edges, {name, con, name, RouteData[2][2]}); endif endif endfor endfor labels = {}; for edge in (edges) {A, B, Node, PacketTime} = edge; Label = tostr(" ", Node, " [label=\"", Node, " (", $string_utils:trimr($string_utils:trimr(floatstr(PacketTime, 2), "0"), "."), ")\"];"); if (!(Label in labels)) labels = {@labels, Label}; endif output = {@output, tostr(" ", A, " -- ", B, ";")}; endfor return {@output, @labels, "}"}; ""; "ChangeLog:"; "3/31/2002 - Initial version"; "10/19/2002 - Font changes"; "1/18/2003 - Attempt to fix lockup issues"; "1/20/2003 - Fixes some syntax issues & removes duplicate labels"; ""; "Last modified Mon Jan 20 15:04:51 2003 CST by SunWizard, #117@Rupert."; . "********* "sunnet_utils "********* ;`property_info(#0, "sunnet_utils") ! E_PROPNF => add_property(#0, "sunnet_utils", `property_info(#0, "recycler") ! ANY => 0' ? $recycler:_create($generic_utils) | create($generic_utils), {player, "r"})'; ;$sunnet_utils.name = "SunNET Utilities and User Interface"; ;$sunnet_utils.aliases = {"SunNET Utilities and User Interface", "SunNET Utils"}; ;$sunnet_utils.description = "This is a placeholder parent for all the $..._utils packages, to more easily find them and manipulate them. At present this object defines no useful verbs or properties. (Filfre.)"; ;$sunnet_utils.r = 1; "PROPS ;`property_info($sunnet_utils, "trusts") ! E_PROPNF => add_property($sunnet_utils, "trusts", {}, {player, "rc"})'; ;`property_info($sunnet_utils, "time_differential") ! E_PROPNF => add_property($sunnet_utils, "time_differential", 0, {player, "r"})'; ;`property_info($sunnet_utils, "MOO_names") ! E_PROPNF => add_property($sunnet_utils, "MOO_names", `{$network.moo_name} ! E_PROPNF => {"unknown"}', {player, "r"})'; ;`property_info($sunnet_utils, "spaces") ! E_PROPNF => add_property($sunnet_utils, "spaces", " ", {player, "rc"})'; ;`property_info($sunnet_utils, "id_counter") ! E_PROPNF => add_property($sunnet_utils, "id_counter", max(random(`$maxint ! E_PROPNF => 2147483647'), 0), {player, "r"})'; ;`property_info($sunnet_utils, "log") ! E_PROPNF => add_property($sunnet_utils, "log", {}, {player, ""})'; ;`property_info($sunnet_utils, "max_tries") ! E_PROPNF => add_property($sunnet_utils, "max_tries", 10, {player, "rc"})'; ;`property_info($sunnet_utils, "neval") ! E_PROPNF => add_property($sunnet_utils, "neval", {}, {player, ""})'; ;`property_info($sunnet_utils, "banned") ! E_PROPNF => add_property($sunnet_utils, "banned", {}, {player, "rc"})'; "VERBS ;`verb_info($sunnet_utils, "log_entry") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "log_entry"}, {"this", "none", "this"})'; .program $sunnet_utils:log_entry "SunNET 3.0a2"; ":log_entry(@LIST stuff to log);"; " Add the sttuf to log into the .log property"; if (caller_perms().wizard || caller_perms() == $no_one || parent(caller) == $sunnet_link) who = player; if (valid(who)) if ("login_key" in properties(parent(who))) who = who.login_key; else who = who.name; endif else who = tostr(who); endif this.log = {@this.log, tostr(ctime()[5..19], ": ", who, " -> ", @args)}; else raise(E_PERM); endif "Last modified Mon Apr 1 10:20:21 2002 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "is_traceback") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "is_traceback"}, {"this", "none", "this"})'; .program $sunnet_utils:is_traceback "SunNET 3.0a2"; ":is_traceback(STR line);"; "=> 1 if line looks like a line from a trace back, otherwise, 0"; form1 = "#.+:.+, line [0-9]+: .+"; form2 = "... called from #.+:.+, line [0-9]+"; form3 = "... called from built-in function"; form4 = "(End of traceback)"; what = args[$]; result = match(what, form1) || match(what, form2) || match(what, form3) || match(what, form4); return result ? 1 | 0; . ;`verb_info($sunnet_utils, "format") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "format"}, {"this", "none", "this"})'; .program $sunnet_utils:format "SunNET 3.0a2"; ":format([INT total length], STR format string, [@data subs]);"; "=> format string with appropriate substitutions"; " %INT --> Left justify corresponding element from data subs"; " %-INT --> Right justify corresponding element from data subs"; " %>INT --> Center corresponding element from data subs"; " % --> No justifiction"; " %% --> A % symbol"; if (typeof(args[1]) == INT) {final, format, @subs} = args; else final = 0; {format, @subs} = args; endif if (typeof(format) != STR) raise(E_TYPE); endif new = ""; su = $string_utils; while (format) if (n = index(format, "%")) new = tostr(new, format[1..n - 1]); format = format[n + 1..$]; if (`format[1] == "%" ! ANY => 0') new = tostr(new, "%"); format = format[2..$]; else v = "left"; if (`format[1] == "-" ! ANY => 0') v = "right"; format = `format[2..$] ! ANY => ""'; elseif (`format[1] == ">" ! ANY => 0') v = "center"; format = `format[2..$] ! ANY => ""'; endif hold = ""; while (`index("0123456789", c = format[1]) ! ANY => 0') hold = tostr(hold, c); format = `format[2..$] ! ANY => ""'; endwhile if (hold) new = tostr(new, su:(v)(`subs[1] ! ANY => ""', -toint(hold))); subs = `listdelete(subs, 1) ! ANY => {}'; else new = tostr(new, `subs[1] ! ANY => ""'); subs = `listdelete(subs, 1) ! ANY => {}'; endif endif else new = tostr(new, format); format = ""; endif ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endwhile new = tostr(new, @subs); new = `new[1..final || $] ! E_RANGE => new'; return new; . ;`verb_info($sunnet_utils, "broadcast") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "broadcast"}, {"this", "none", "this"})'; .program $sunnet_utils:broadcast "SunNET 4.2.0"; ":broadcast(STR destination, STR protocol, ANY message, "; " [OBJ ack object, STR ack verb, [OBJ fail object, STR fail verb]])"; "=> result of the call"; "=> Raises an error if the call fails"; "if the optional parameters `ack object' and `ack verb' are provided,"; " Then that verb will be called when and ACK command is received with"; " the id returned to the user... This should be useful for calls that"; " absolutely have to make it to the destination..."; "if the parameters `fail object' and `fail verb' are provided, then that"; " verb will be called if the message is unable to be sent."; if ($sunnet.active) who = caller_perms(); dest = args[1]; proto = args[2]; msg = args[3]; ackobject = failobject = $nothing; ackverb = failverb = ""; if (length(args) == 5 || length(args) == 7) ackobject = args[4]; ackverb = args[5]; if (length(args) == 7) failobject = args[6]; failverb = args[7]; endif endif if (typeof(dest) != STR || typeof(proto) != STR || typeof(ackobject) != OBJ || typeof(ackverb) != STR || typeof(failobject) != OBJ || typeof(failverb) != STR) raise(E_INVARG); endif if (caller in {$sunnet, $sunnet_protocols, $sunnet_fo} || who.wizard || who in this.trusts || ((tmp = $sunnet:get_handler(proto)) && who == tmp[1].owner)) packet = this:create_message(dest, proto, msg); return this:sendon($nothing, packet, {ackobject, ackverb}, {failobject, failverb}); else raise(E_PERM); endif endif ""; "ChangeLog:"; " 3/ 4/2006 - Removed incomplete/unfinished sunnet_secure stuff."; ""; "Last modified Sat Mar 4 01:50:35 2006 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "create_message") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "create_message"}, {"this", "none", "this"})'; .program $sunnet_utils:create_message "SunNET 3.0a2"; ":create_message(STR destination, STR protocol, ANY message)"; "=> {NUM timestamp, NUM id, LIST path, STR destination, "; " STR protocol, ANY message}"; if (length(args) != 3) raise(E_INVARG); endif id = this.id_counter = max(this.id_counter + 1, 0); return {time(), id, {}, @args}; . ;`verb_info($sunnet_utils, "sendon") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "sendon"}, {"this", "none", "this"})'; .program $sunnet_utils:sendon "SunNET 3.0a2"; ":sendon(OBJ origplayer, {NUM time, NUM id, LIST path, STR dest"; " STR protocol, ANY message}, {OBJ ack object, STR ack verb},"; " {OBJ failure handler object, STR failure verb});"; "adds the packet to the queue of packets to send."; if (caller_perms().wizard) {who, packet, ackhandler, failhandler} = args; ack = ackhandler[1] != $nothing; packet[3] = {@packet[3], this.moo_names[1]}; packet = {ack, @packet}; been = who != $nothing ? {$sunnet:connection_name(who)} | {}; return $sunnet:enqueue(been, ackhandler, failhandler, packet); else raise(E_PERM); endif "Last modified Sat Sep 21 20:28:38 2002 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "shutdown") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "shutdown close_connection open_connection bootstrap reboot"}, {"this", "none", "this"})'; .program $sunnet_utils:shutdown "SunNET 3.0a2"; ":shutdown() --> Closes SunNET"; ":bootstrap() --> Attempts to open all SunNET connections which are closed"; ":reboot() --> Called Shutdown, pauses 30 seconds then calls bootstrap"; ":open_connection(STR sitename)"; " --> Attempts to open a connection to sitename only if there"; " is an information record in .outbound_connection_info"; ":close_connection(STR sitename)"; " --> Closes the connection (if any) associtated with sitename"; if (caller_perms().wizard || caller_perms() in this.trusts) return $sunnet:(verb)(@args); else raise(E_PERM); endif . ;`verb_info($sunnet_utils, "is_lambdacore") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "is_lambdacore"}, {"this", "none", "this"})'; .program $sunnet_utils:is_lambdacore "SunNET 3.0a2"; ":is_lambdacore();"; "=> True or False"; "Attempts to `detect' if the core is based off of LambdaCORE"; p = properties(#0); return "recycler" in p && "room" in p && "player_class" in p && "wiz" in p && "mail_agent" in p; . ;`verb_info($sunnet_utils, "listening_sites") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "listening_sites"}, {"this", "none", "this"})'; .program $sunnet_utils:listening_sites "SunNET 4.1.0"; ":listening_sites();"; "=> List of known sites to this site."; if (caller_perms().wizard || caller_perms() in this.trusts) return {@$sunnet.active ? {this.moo_names[1]} | {}, @$list_utils:slice($sunnet.connection_table)}; else raise(E_PERM); endif "5/29/2005 - Verb security added"; ""; "Last modified Sun May 29 02:07:27 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "true_name") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "true_name"}, {"this", "none", "this"})'; .program $sunnet_utils:true_name "SunNET 4.1.0"; ":true_name();"; "If given an alias of a known site, the true name of the site will be"; "returned otherwise the given argument is returned."; if (caller_perms().wizard || caller_perms() in this.trusts) for x in ($sunnet.alias_table) if (args[1] in x) return x[1]; endif endfor if (args[1] in this.moo_names) return this.moo_names[1]; endif return args[1]; else raise(E_PERM); endif ""; "Changelog"; "5/29/2005 - Added verb security"; ""; "Last modified Sun May 29 02:42:48 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "help_msg") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "help_msg"}, {"this", "none", "this"})'; .program $sunnet_utils:help_msg "SunNET 3.0a2"; all_help = this.help_msg; if (typeof(all_help) == STR) all_help = {all_help}; endif helpless = {}; for x in (setremove(verbs(this), verb)) vrb = $string_utils:words(strsub(x, "*", " "))[1]; if (loc = $object_utils:has_verb(this, vrb)) loc = loc[1]; help = $code_utils:verb_documentation(loc, vrb); if (help) all_help = {@all_help, "", tostr(loc, ":", verb_info(loc, vrb)[3]), @help}; else helpless = {@helpless, vrb}; endif endif endfor if (helpless) all_help = {@all_help, "", "No help found on " + this:english_list(helpless, "nothing", " or ") + "."}; endif return {@all_help, "----"}; . ;`verb_info($sunnet_utils, "verb_call") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "verb_call send"}, {"this", "none", "this"})'; .program $sunnet_utils:verb_call "SunNET 4.2.0"; ":call_verb(STR moo, OBJ object | STR object, STR verb, [@LIST args])"; "makes a verb call on for :() "; "if object is a string, the verb will be matched on the remote location"; "the called verb should be charged with the task of returning a result."; if (caller_perms() in this.banned) raise(E_PERM); endif if ($sunnet.active) if (args[1] in this.moo_names) set_task_perms(caller_perms()); rcallreturn = verb == "verb_call"; object = args[2]; vrb = args[3]; oldargs = args; args = listdelete(listdelete(listdelete(args, 1), 1), 1); if (typeof(object) == STR) if (this:is_lambdacore()) object = $string_utils:match_object(object, $nothing); else object = $no_one:eval_d(o = object); if (object[1] && typeof(object[2]) == OBJ && valid(object[2])) object = object[2]; else object = toobj(o); endif endif endif if (object == $nothing) suspend(0); tmp = eval(";return " + vrb + "(@" + toliteral(args) + ");"); else suspend(0); tmp = {1, object:(vrb)(@args)}; endif if (rcallreturn) return tmp; else return {1, 0}; endif elseif (this:true_name(args[1]) in this:listening_sites()) oid = task_id(); fork (0) try t = this:broadcast(args[1], "RCALL", tmp = {verb != "send" ? oid | 0, args[2..length(args)]}); `resume(oid, {1, t}) ! ANY'; except e (E_NACC) `resume(oid, {$maxint, $minint}) ! ANY'; endtry endfork if (verb == "send") return {1, 0}; endif waiting = task_id(); fork id (5 * this.max_tries) `resume(waiting, {$maxint, $minint}) ! ANY'; endfork z = suspend(); if (z == {$maxint, $minint}) return {0, "Remote verb never returned."}; endif `kill_task(id) ! E_INVARG'; z = `z[2] ! E_RANGE, E_TYPE => {0, "Internal Error"}'; ret = args[2] == $nothing ? z | {1, z}; return ret; else return {0, toliteral(args[1]) + " not found."}; endif else return {0, "SunNET inactive"}; endif ""; "ChangeLog:"; " 1/23/2003 - Fixed code to properly recognize timeout conditions."; " 5/29/2005 - Added banned security"; " 3/ 4/2006 - Removed incomplete/unfinished sunnet_secure stuff."; ""; "Last modified Sat Mar 4 01:49:09 2006 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "eval") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "eval eval_d"}, {"this", "none", "this"})'; .program $sunnet_utils:eval "SunNET 4.1.0"; ":eval(STR destination, STR verb code to eval)"; "=> {NUM success, STR message for failure || ANY returned value}"; " if eval_d is used, the code is execuded with the d bit unset."; if (caller_perms() in this.banned) raise(E_PERM); endif if ($sunnet.active) set_task_perms(caller_perms()); {dest, code} = args; if (verb == "eval") object = $nothing; vrb = "eval"; else object = "$no_one"; vrb = "eval_d"; endif if (code[$] != ";") code = code + ";"; endif tmp = this:verb_call(dest, object, vrb, code); if (tmp[1]) return tmp[2]; else return tmp; endif else return {0, "SunNET inactive"}; endif ""; "Changelog:"; "5/29/2005 - Added banned security"; ""; "Last modified Sun May 29 02:21:14 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "init_for_core") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "init_for_core"}, {"this", "none", "this"})'; .program $sunnet_utils:init_for_core "SunNET 4.2.0"; if (caller_perms().wizard) this.time_differential = 0; this.id_counter = max(random($maxint), 0); this.moo_names = {$network.moo_name}; this.log = {}; this.max_tries = 10; this.trusts = {}; this.spaces = " "; return pass(@args); else raise(E_PERM); endif ""; "ChangeLog:"; " 3/ 4/2006 - Removed obsolete rot13 function."; ""; "Last modified Sat Mar 4 01:53:30 2006 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "compile_rwho_list") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "compile_rwho_list"}, {"this", "none", "this"})'; .program $sunnet_utils:compile_rwho_list "SunNET 3.0a2"; all = 0; while (args && "" in args[1]) args[1] = setremove(args[1], ""); all = 1; endwhile if (args && args[1]) oplyrs = args[1]; plyrs = $list_utils:flatten({$string_utils:match_player(oplyrs)}); else plyrs = {}; endif plyrs = plyrs || $set_utils:difference(connected_players(), children($sunnet_link)); if (all) plyrs = {@plyrs, @$set_utils:difference(connected_players(), children($sunnet_link))}; endif plyrs = $list_utils:remove_duplicates(plyrs); nfo = nfo2 = {}; for i in [1..length(plyrs)] x = plyrs[i]; if (valid(x)) h = {x, x.name, t = x in connected_players()}; h = {@h, t ? idle_seconds(x) | ($object_utils:has_property(x, "last_disconnect_time") ? x.last_disconnect_time | "unknown")}; h = {@h, t ? connected_seconds(x) | "not connected"}; h = {@h, t = x.location, valid(t) ? $object_utils:has_callable_verb(t, "who_location_msg") ? t:who_location_msg(x) | t.name | tostr("Invalid Object ", x.location)}; nfo = {@nfo, h}; ticks_left() < 4000 || seconds_left() < 2 && suspend(1); elseif (x == $nothing) nfo2 = {@nfo2, tostr(toliteral(oplyrs[i]), " is not the name of any player.")}; else nfo2 = {@nfo2, tostr(toliteral(oplyrs[i]), " could refer to ", $string_utils:title_list($player_db:find_all(oplyrs[i]), "noone", " or "), ".")}; endif endfor return {nfo, nfo2}; "Last modified Mon Sep 23 13:48:24 2002 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "short_time") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "short_time"}, {"this", "none", "this"})'; .program $sunnet_utils:short_time "SunNET 3.0a2"; ":short_time(number)"; "=> STR short time format"; units = {"year", "month", "day", "hour", "minute", "second"}; tounits = "ymdhms"; tstr = strsub(this:english_time(@args), "and", ""); for x in (units) d = tounits[x in units]; tstr = strsub(tstr, tostr(x, "s"), d); tstr = strsub(tstr, x, d); endfor tstr = strsub(tstr, ",", ""); tstr = strsub(tstr, " ", ""); return tstr; . ;`verb_info($sunnet_utils, "parse_mooref") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "parse_mooref"}, {"this", "none", "this"})'; .program $sunnet_utils:parse_mooref "SunNET 3.0a2"; if (ind = rindex(args[1], "@")) who = args[1][1..ind - 1]; moo = args[1][ind + 1..length(args[1])]; else who = args[1]; moo = this.moo_names[1]; endif return {who, this:true_name(moo)}; . ;`verb_info($sunnet_utils, "english_bytes") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "english_bytes"}, {"this", "none", "this"})'; .program $sunnet_utils:english_bytes "SunNET 3.0a2"; "Copied from $world_utils:english_bytes (from World)"; {bytes, ?maxdec = 2} = args; neg = tofloat(bytes) < 0.0 ? "-" | ""; bytes = tofloat(abs(bytes)); if (maxdec < 0) raise(E_INVARG); else maxdec = maxdec > 19 ? 19 | maxdec; endif kb = 1024.0; mb = kb * kb; gb = mb * kb; if (bytes < kb) return tostr(neg, bytes, "b"); elseif (bytes < mb) tot = tofloat(bytes / kb) + tofloat(bytes % kb) / tofloat(kb); idx = 0; tot = tofloat(floatstr(tot, maxdec)); while (tot / tofloat(floatstr(tot, idx)) != 1.0) idx = idx + 1; endwhile return tostr(neg, floatstr(tot, idx), "kb"); elseif (bytes < gb) tot = tofloat(bytes / mb) + tofloat(bytes % mb) / tofloat(mb); idx = 0; tot = tofloat(floatstr(tot, maxdec)); while (tot / tofloat(floatstr(tot, idx)) != 1.0) idx = idx + 1; endwhile return tostr(neg, floatstr(tot, idx), "mb"); else tot = tofloat(bytes / gb) + tofloat(bytes % gb) / tofloat(gb); idx = 0; tot = tofloat(floatstr(tot, maxdec)); while (tot / tofloat(floatstr(tot, idx)) != 1.0) idx = idx + 1; endwhile return tostr(neg, floatstr(tot, idx), "gb"); endif . ;`verb_info($sunnet_utils, "proto") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "proto*cols"}, {"this", "none", "this"})'; .program $sunnet_utils:proto "SunNET 3.0a2"; ":protocols(SITE, [protocol])"; " => protocols SITE can handle, if second argument is not provided or is false"; " => 1, if second argument is given and site supports the protocol"; " => 0, if second argument is given and site does not support the protocol"; if (caller_perms() in this.trusts) {site, ?proto = ""} = args; if (i = this:iassoc(site, this.protocol_table)) return !proto ? this.protocol_table[i][2] | proto in this.protocol_table && 1; else return proto ? 0 | {}; endif else raise(E_PERM); endif . ;`verb_info($sunnet_utils, "rlist_helper") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "rlist_helper"}, {"this", "none", "this"})'; .program $sunnet_utils:rlist_helper "SunNET 3.0a2"; "For use on LambdaCore-based MOOs"; ":rlist_helper(objectname, verbname, allparenthesisflag, allverbsflag, "; " [argspec])"; "=> {objectNum, originalArgs, {{ancestor, code, info, args},...}"; set_task_perms(caller_perms()); {objectname, verbname, ?pflag = 1, ?aflag = 0, ?argspec = {}} = args; object = $string_utils:match_object(objectname, $nothing); codelist = {}; if (valid(object)) if (argspec) argspec[2] = $code_utils:full_prep(argspec[2]); endif for what in ({object, @$object_utils:ancestors(object)}) built_one = 0; for x in [1..length(verbs(what))] ticks_left() < 4000 || seconds_left() < 2 && suspend(0); vinfo = `verb_info(what, x) ! ANY'; if (verbname == x || `$code_utils:verbname_match(vinfo[3], verbname) ! E_TYPE => 0') vargs = `verb_args(what, x) ! ANY'; if (!argspec || vargs == argspec) vcode = `verb_code(what, x, pflag) ! ANY'; codelist = {@codelist, {what, vcode, vinfo, vargs}}; built_one = 1; if (!aflag) break x; endif endif endif endfor if (built_one && !aflag) break what; endif endfor endif return {object, args, codelist}; . ;`verb_info($sunnet_utils, "neval") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "neval neval_d"}, {"this", "none", "this"})'; .program $sunnet_utils:neval "SunNET 3.0a2"; " neval "; " neval_d - network eval (, , -> r{}"; {sites, eval, ?suspend = 1800} = args; outer = task_id(); set_task_perms(caller_perms()); fork (0) task = task_id(); this.neval = {@this.neval, {task, {}}}; m = length(sites); for node in (sites) fork (0) r = this:(verb[2..$])(node, eval); if ($list_utils:iassoc(task, queued_tasks()) && (i = $list_utils:iassoc(task, this.neval))) this.neval[i][2] = {@this.neval[i][2], {node, r}}; if (length(this.neval[i][2]) == m) resume(task); endif endif endfork endfor suspend(suspend); if (i = $list_utils:iassoc(task, this.neval)) r = this.neval[i][2]; this.neval = listdelete(this.neval, i); else r = {}; endif resume(outer, r); endfork return suspend(suspend * 2) || {}; "5/28/98: Submitted by Samuel Latt Epstein"; "Last modified Fri Jun 11 08:40:15 2004 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "english_list") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "english_list"}, {"this", "none", "this"})'; .program $sunnet_utils:english_list "SunNET 3.0a2"; "Prints the argument (must be a list) as an english list, e.g. {1, 2, 3} is printed as \"1, 2, and 3\", and {1, 2} is printed as \"1 and 2\"."; "Optional arguments are treated as follows:"; " Second argument is the string to use when the empty list is given. The default is \"nothing\"."; " Third argument is the string to use in place of \" and \". A typical application might be to use \" or \" instead."; " Fourth argument is the string to use instead of a comma (and space). Gary_Severn's deranged mind actually came up with an application for this. You can ask him."; " Fifth argument is a string to use after the penultimate element before the \" and \". The default is to have a comma without a space."; {things, ?nothingstr = "nothing", ?andstr = " and ", ?commastr = ", ", ?finalcommastr = ","} = args; nthings = length(things); if (nthings == 0) return nothingstr; elseif (nthings == 1) return tostr(things[1]); elseif (nthings == 2) return tostr(things[1], andstr, things[2]); else ret = ""; for k in [1..nthings - 1] if (k == nthings - 1) commastr = finalcommastr; endif ret = tostr(ret, things[k], commastr); endfor return tostr(ret, andstr, things[nthings]); endif . ;`verb_info($sunnet_utils, "time") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "time"}, {"this", "none", "this"})'; .program $sunnet_utils:time return time() + this.time_differential; . ;`verb_info($sunnet_utils, "english_time") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "english_time"}, {"this", "none", "this"})'; .program $sunnet_utils:english_time "Copied from time utilities (#41):english_time by Hacker (#36) Sun May 31 14:41:42 1998 CDT"; "english_time(time [,reference time]): returns the time as a string of"; "years, months, days, hours, minutes and seconds using the reference time as"; "the start time and incrementing forwards. it can be given in either ctime()"; "or time() format. if a reference time is not given, it is set to time()."; "suspend(0)"; {_time, ?reftime = this:time()} = args; _ctime = typeof(reftime) == NUM ? ctime(reftime) | reftime; seclist = {60, 60, 24}; units = {"year", "month", "day", "hour", "minute", "second"}; timelist = {}; for unit in (seclist) timelist = {_time % unit, @timelist}; _time = _time / unit; endfor months = 0; month = _ctime[5..7] in {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; year = tonum(_ctime[21..24]); "the following should really be a verb/property. attribution: the "; "algorithm used is from the eminently eminent g7."; monthlen = {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}; while (_time >= (days = monthlen[month] + (month == 2 && year % 4 == 0 && !(year % 400 in {100, 200, 300})))) _time = _time - days; months = months + 1; if ((month = month + 1) > 12) year = year + 1; month = 1; endif endwhile timelist = {months / 12, months % 12, _time, @timelist}; for unit in (units) i = unit in units; if (timelist[i] > 0) units[i] = tostr(timelist[i]) + " " + units[i] + (timelist[i] == 1 ? "" | "s"); else units = listdelete(units, i); timelist = listdelete(timelist, i); endif endfor "suspend(0)"; return this:english_list(units); . ;`verb_info($sunnet_utils, "rrun") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "rrun rrun_d"}, {"this", "none", "this"})'; .program $sunnet_utils:rrun "SunNET 4.1.0"; ":rrun(STR node, OBJ object, STR verb, [@LIST args]);"; "=> {1, result}"; "=> {0, error}"; "Remotely runs the local verb specified by object:verb and returns "; "the result"; ""; "Thanks to Wingy@Snow for the idea, and Keith@ComMOOnity for the code"; if (caller_perms() in this.banned) raise(E_PERM); endif {node, object, vrb, @rest} = args; set_task_perms(caller_perms()); if (node in this.moo_names) if (verb == "rrun") return {1, object:(vrb)(@rest)}; else return {1, `object:(vrb)(@rest) ! ANY'}; endif elseif (node == "GENERAL") raise(E_INVARG); elseif (index(verb_info(object, vrb)[2], "x")) c = verb_code(object, vrb); c = {";;args = " + toliteral(rest) + "; ", @c}; code = ""; for x in (c) if (!match(x, "^\".*\";$")) code = tostr(code, x, " "); endif endfor if (verb == "rrun_d") return this:eval_d(node, code); else return this:eval(node, code); endif else raise(E_VERBNF); endif ""; "Changelog:"; "5/29/2005 - Added verb security"; ""; "Last modified Thu Jun 4 00:37:31 1998 CDT by SunWizard, #117@Rupert."; ">>> Last compiled : Wed Jun 10 10:27:03 1998 JST by SunWiz (#1663) at SenseMedia/Snow. <<<"; "Last modified Sun May 29 02:22:12 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_utils, "linesplit") ! E_VERBNF => add_verb($sunnet_utils, {player, "rxd", "linesplit"}, {"this", "none", "this"})'; .program $sunnet_utils:linesplit "SunNET 3.0a2"; ":linesplit(line,len[,indent|spaces]) => List of substrings of line."; line = args[1]; len = args[2]; spaces = ""; if (length(args) < 3) indent = 5; elseif (typeof(indent = args[3]) == NUM) indent = args[3]; else indent = -length(spaces = indent); endif indent = min(indent, len - 1); cline = {}; if (length(line) <= len) return {line}; elseif (indent < 0) spaces = spaces || $string_utils:space(indent = abs(indent)); elseif (indent) cutoff = rindex(line[1..len - indent], " "); if (nospace = cutoff < 4 * len / 5) cutoff = len + 1; nospace = line[cutoff] != " "; endif cline = {$string_utils:space(indent) + line[1..cutoff - 1]}; line = line[cutoff + 1..length(line)]; indent = 0; endif while (length(line) > len) cutoff = rindex(line[1..len], " "); if (cutoff < 4 * len / 5) cutoff = len + 1; endif cline = {@cline, line[1..cutoff - 1]}; line = (indent ? spaces | "") + line[cutoff + 1..length(line)]; endwhile if (indent > 0) while (line[1] == " ") line = line[2..length(line)]; endwhile endif return {@cline, line}; . "********* "sunnet_protocols "********* ;`property_info(#0, "sunnet_protocols") ! E_PROPNF => add_property(#0, "sunnet_protocols", `property_info(#0, "recycler") ! ANY => 0' ? $recycler:_create($generic_utils) | create($generic_utils), {player, "r"})'; ;$sunnet_protocols.name = "SunNET Base Level Protocols"; ;$sunnet_protocols.aliases = {"SunNET Base Level Protocols", "sunnet_protocols"}; ;$sunnet_protocols.description = "This is a placeholder parent for all the $..._utils packages, to more easily find them and manipulate them. At present this object defines no useful verbs or properties. (Filfre.)"; ;$sunnet_protocols.r = 1; "PROPS ;`property_info($sunnet_protocols, "active_threshold") ! E_PROPNF => add_property($sunnet_protocols, "active_threshold", 300, {player, "r"})'; "VERBS ;`verb_info($sunnet_protocols, "ACK") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rxd", "ACK"}, {"this", "none", "this"})'; .program $sunnet_protocols:ACK "SunNET 3.2"; "The ACK protocol is an acknowlegement notifier for the packet routing system."; "In addition, it also provides timing information."; {from, proto, msg, path, id, time, @rest} = args; if (caller_perms().wizard || caller == $sunnet) {toid, topath, totime, theirtime, packetresult} = msg; if (i = $list_utils:iassoc(toid, $sunnet.outbound_messages)) {id, task, ackhandler, packet} = $sunnet.outbound_messages[i]; "We have the ACK, so get rid of the old packet."; rslt = {toid, topath, path, totime, packetresult}; $sunnet.outbound_messages = listdelete($sunnet.outbound_messages, i); resume(task, {1, rslt}); endif triptime = time() - totime; if (triptime < 0) return; endif directcon = `topath[2] ! E_RANGE => from'; destin = from; if (i = $list_utils:iassoc(destin, $sunnet.routes)) routes = listdelete($sunnet.routes[i], 1); if (j = $list_utils:iassoc(directcon, routes)) routes[j][5] = triptime; routes[j][4] = routes[j][4] + 1; routes[j][3] = routes[j][3] + triptime; routes[j][2] = tofloat(routes[j][3]) / tofloat(routes[j][4]); $sunnet.routes[i][2..$] = $list_utils:sort_alist(routes, 2); endif endif else raise(E_PERM); endif return; ""; "ChangeLog:"; "3/31/2002 - Added last round-trip time, and changed average round-trip time to an floating point value."; ""; "Last modified Sat Sep 21 21:57:21 2002 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_protocols, "ALIAS") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rxd", "ALIAS"}, {"this", "none", "this"})'; .program $sunnet_protocols:ALIAS "SunNET 3.0a2"; if (caller == $sunnet || caller_perms().wizard) args = args[3]; if (i = $list_utils:iassoc(args[1], $sunnet.alias_table)) $sunnet.alias_table[i] = args; else $sunnet.alias_table = {@$sunnet.alias_table, args}; endif else raise(E_PERM); endif . ;`verb_info($sunnet_protocols, "IKNOW") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rxd", "IKNOW"}, {"this", "none", "this"})'; .program $sunnet_protocols:IKNOW "SunNET 3.0a2"; if (caller == $sunnet || caller_perms().wizard) $sunnet:add_entry(args[1], args[3]); else raise(E_PERM); endif . ;`verb_info($sunnet_protocols, "init_for_core") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rxd", "init_for_core"}, {"this", "none", "this"})'; .program $sunnet_protocols:init_for_core "SunNET 4.1.0"; if (caller_perms().wizard) this.active_threshold = 300; $sunnet:add_protocol("ACK", this, "ACK"); $sunnet:add_protocol("ALIAS", this, "ALIAS"); $sunnet:add_protocol("IKNOW", this, "IKNOW"); $sunnet:add_protocol("RCALL", this, "RCALL"); $sunnet:add_protocol("RWHO", this, "RWHO"); $sunnet:add_protocol("RPAGE", this, "RPAGE"); $sunnet:add_protocol("PROTOS", this, "PROTOS"); return pass(@args); else raise(E_PERM); endif ""; "ChangeLog:"; "6/12/2005, SunWizard - Fixed the missing registration for the PROTOS protocol."; ""; "Last modified Sun Jun 12 14:48:57 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_protocols, "RCALL") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rx", "RCALL"}, {"this", "none", "this"})'; .program $sunnet_protocols:RCALL "SunNET 4.1.0"; {from, proto, msg, path, id, time} = args; {rcallreturn, msg} = form = msg; {object, vrb, @args} = msg; if (caller == $sunnet || caller_perms().wizard) if (typeof(object) == STR) if ($sunnet_utils:is_lambdacore()) object = $string_utils:match_object(object, $nothing); else object = $no_one:eval_d(o = object); if (object[1] && typeof(object[2]) == OBJ && valid(object[2])) object = object[2]; else object = toobj(o); endif endif endif if (object == $nothing) set_task_perms($no_one); suspend(0); try tmp = eval(";return " + vrb + "(@" + toliteral(args) + ");"); except e (ANY) tmp = {0, e}; endtry else set_task_perms($no_one); suspend(0); try tmp = object:(vrb)(@args); except e (ANY) tmp = {0, e}; endtry endif if (rcallreturn) return tmp; endif else raise(E_PERM); endif ""; "Changelog:"; "5/29/2005, SunWizard - Added verb security"; ""; "Last modified Sun May 29 02:26:18 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_protocols, "SHUTDOWN") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rxd", "SHUTDOWN"}, {"this", "none", "this"})'; .program $sunnet_protocols:SHUTDOWN "SunNET 4.1.0"; if (caller == $sunnet || caller_perms().wizard) $sunnet:clear_connection(args[1][length(args[1])]); $sunnet_utils:broadcast("GENERAL", "ALIAS", $sunnet_utils.moo_names); $sunnet_utils:broadcast("GENERAL", "IKNOW", $sunnet_utils:listening_sites()); else raise(E_PERM); endif ""; "Changelog"; "5/29/2005, SunWizard - Fixed verb security"; ""; "Last modified Sun May 29 02:27:33 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_protocols, "PROTOS") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rxd", "PROTOS"}, {"this", "none", "this"})'; .program $sunnet_protocols:PROTOS "SunNET 4.1.0"; "The PROTOS protocol handler. Simply adds or updates information in the"; "protocols table."; if (caller == $sunnet || caller_perms().wizard) from = args[1]; protos = args[3]; if (i = $list_utils:iassoc(from, tmp = $sunnet.protocol_table)) $sunnet.protocol_table[i][2] = protos; else $sunnet.protocol_table = {@tmp, {from, protos}}; endif else raise(E_PERM); endif ""; "Changelog"; "5/29/2005, SunWizard - Fixed verb security"; ""; "Last modified Sun May 29 02:29:55 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_protocols, "RWHO") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rxd", "RWHO"}, {"this", "none", "this"})'; .program $sunnet_protocols:RWHO "SunNET 4.1.0"; {from, proto, msg, @rest} = args; if (caller == $sunnet || caller_perms().wizard) return $sunnet_utils:compile_rwho_list(msg); else raise(E_PERM); endif ""; "Changelog"; "5/29/2005, SunWizard - Fixed verb security"; ""; "Last modified Sun May 29 02:30:49 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_protocols, "RPAGE") ! E_VERBNF => add_verb($sunnet_protocols, {player, "rxd", "RPAGE"}, {"this", "none", "this"})'; .program $sunnet_protocols:RPAGE "SunNET 4.1.0"; {from, proto, msg, path, id, time} = args; {whostr, message} = msg; if (caller == $sunnet || caller_perms().wizard) who = $string_utils:match_player(whostr); if (valid(who)) r = who:receive_page(@message); if (r == 2) ret = {$object_utils:has_callable_verb(who, "page_absent_msg") ? who:page_absent_msg() | $string_utils:pronoun_sub("%n % not currently logged in.", who)}; elseif (r == 0) ret = {who:page_refused_msg()}; else ret = {who:page_echo_msg()}; endif else ret = {tostr("No such user as ", who, ".")}; endif return ret; else raise(E_PERM); endif ""; "Changelog"; "5/29/2005, SunWizard - Fixed verb security"; ""; "Last modified Sun May 29 02:31:31 2005 CDT by SunWizard, #117@Rupert."; . "********* "sunnet_link "********* ;`property_info(#0, "sunnet_link") ! E_PROPNF => add_property(#0, "sunnet_link", `property_info(#0, "recycler") ! ANY => 0' ? $recycler:_create($player) | create($player), {player, "r"})'; ;$sunnet_link.name = "SunNET Link"; ;$sunnet_link.aliases = {"SunNET Link"}; ;$sunnet_link.description = "You see a player who should type '@describe me as ...'."; ;$sunnet_link.r = 1; "PROPS ;`property_info($sunnet_link, "login_key") ! E_PROPNF => add_property($sunnet_link, "login_key", "", {player, ""})'; ;`property_info($sunnet_link, "call_allowed_to") ! E_PROPNF => add_property($sunnet_link, "call_allowed_to", {}, {player, ""})'; ;`property_info($sunnet_link, "call_allowed_from") ! E_PROPNF => add_property($sunnet_link, "call_allowed_from", {}, {player, ""})'; ;`property_info($sunnet_link, "secure_verbs") ! E_PROPNF => add_property($sunnet_link, "secure_verbs", {}, {player, ""})'; ;`property_info($sunnet_link, "off") ! E_PROPNF => add_property($sunnet_link, "off", 0, {player, ""})'; ;`property_info($sunnet_link, "net_password") ! E_PROPNF => add_property($sunnet_link, "net_password", "", {player, ""})'; ;`property_info($sunnet_link, "opening_task") ! E_PROPNF => add_property($sunnet_link, "opening_task", 0, {player, "r"})'; "VERBS ;`verb_info($sunnet_link, "DATA") ! E_VERBNF => add_verb($sunnet_link, {player, "rd", "DATA"}, {"any", "any", "any"})'; .program $sunnet_link:DATA "SunNET 3.0a2"; if (player != this) return player:tell("Fat Chance!"); endif $sunnet.recv_bytes = $sunnet.recv_bytes + tofloat(value_bytes(argstr)); set_task_perms(player); if (i = index(argstr, " ")) linkver = `tofloat(argstr[1..i - 1]) ! ANY'; if (typeof(linkver) == ERR) linkver = 0; else argstr[1..i] = ""; endif else linkver = 0; endif base = $no_one:eval_d(tostr(";return ", argstr, ";")); if (base[1] && typeof(base[2]) == LIST) `$sunnet:parse(@base[2]) ! ANY'; else $sunnet_utils:log_entry("BAD COMMAND: ", argstr); endif "Last modified Sat Sep 21 22:07:21 2002 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_link, "#") ! E_VERBNF => add_verb($sunnet_link, {player, "rd", "#* .* (* I*"}, {"any", "any", "any"})'; .program $sunnet_link:# "SunNET 3.0a2"; if (player != this) player:tell("Fat Chance!"); endif . ;`verb_info($sunnet_link, "CLOSE") ! E_VERBNF => add_verb($sunnet_link, {player, "rd", "CLOSE"}, {"none", "none", "none"})'; .program $sunnet_link:CLOSE "SunNET 4.1.0"; if (player != this) return player:tell("Fat chance!"); endif boot_player(this); ""; "Changelog"; "5/29/2005, SunWizard - Added verb security"; ""; "Last modified Sun Jun 12 18:16:31 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_link, "confunc") ! E_VERBNF => add_verb($sunnet_link, {player, "rxd", "confunc disfunc"}, {"this", "none", "this"})'; .program $sunnet_link:confunc "SunNET 4.1.0"; if (valid(cp = caller_perms()) && caller != this && !$perm_utils:controls(cp, this) && caller != $sysobj) raise(E_PERM); endif fork (0) if (verb == "confunc") fork ID (10) if (i = $list_utils:iassoc(this.login_key, $sunnet.bindings)) $sunnet.bindings[i] = {this.login_key, this}; else $sunnet.bindings = setadd($sunnet.bindings, {this.login_key, this}); endif lst = $sunnet.connection_table; lst = `lst[$list_utils:iassoc(this.login_key, lst)][2] ! E_RANGE => {}'; lst = $list_utils:sort(setadd(lst, $sunnet_utils.moo_names[1])); $sunnet:add_entry(this.login_key, lst); endfork this.opening_task = ID; else if (i = $list_utils:iassoc(this.login_key, $sunnet.bindings)) $sunnet.bindings = listdelete($sunnet.bindings, i); endif $sunnet:remove_entry(this.login_key); `kill_task(this.opening_task) ! ANY'; endif $sunnet:notify_info(); endfork if (verb == "disfunc") if (!this.off) fork (0) suspend(30); $sunnet:regenerate_connection(this.login_key, this); endfork endif endif pass(@args); ""; "Changelog"; "5/29/2005, SunWizard - Fixed verb security"; "6/10/2005, SunWizard - Honor the .off property for reopening a connection"; ""; "Last modified Sun Jun 12 00:40:55 2005 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_link, "tell") ! E_VERBNF => add_verb($sunnet_link, {player, "rxd", "tell notify"}, {"this", "none", "this"})'; .program $sunnet_link:tell "SunNET 3.0a2"; return; . "********* "sunnet_fo "********* ;`property_info(#0, "sunnet_fo") ! E_PROPNF => add_property(#0, "sunnet_fo", `property_info(#0, "recycler") ! ANY => 0' ? $recycler:_create($feature) | create($feature), {player, "r"})'; ;$sunnet_fo.name = "SunNET and Login Watcher Feature Object"; ;$sunnet_fo.aliases = {"SunNET and Login Watcher Feature Object"}; ;$sunnet_fo.description = "This is the Generic Feature Object. It is not meant to be used as a feature object itself, but is handy for making new feature objects."; ;$sunnet_fo.r = 1; "PROPS ;`property_info($sunnet_fo, "login_hooks") ! E_PROPNF => add_property($sunnet_fo, "login_hooks", {}, {player, "r"})'; ;`property_info($sunnet_fo, "private_site_info") ! E_PROPNF => add_property($sunnet_fo, "private_site_info", 1, {player, "r"})'; "VERBS ;`verb_info($sunnet_fo, "user_") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "user_*"}, {"this", "none", "this"})'; .program $sunnet_fo:user_ "SunNET 3.0a2"; if ($recycler:valid(args[1]) && (caller == #0 || $perm_utils:controls(caller_perms(), this))) username = `$ansi_utils ! E_PROPNF' != E_PROPNF ? $ansi_utils:ansi_title(args[1]) | args[1].name; tmp = {parent(args[1]) == `$avatar ! E_PROPNF' ? username + " ($avatar from " + args[1].connected_from + ")" | username}; tmp = {@tmp, args[1], strsub(verb[6..length(verb)], "_", " ")}; tmp = {@tmp, length($set_utils:difference(connected_players(), children($sunnet_link)))}; tmp = {@tmp, player.location, valid(player.location) ? player.location.name | "*** Nowhere ***"}; tmp = {@tmp, is_player(player) ? player in connected_players() ? $string_utils:connection_hostname(connection_name(player)) | $string_utils:connection_hostname(player.last_connect_place) | "No.longer.a.player"}; tmp2 = tmp; if (this.private_site_info) tmp[$] = "Private.Site.Info"; endif $sunnet_utils:broadcast("GENERAL", "RLOGIN", tmp); this:rlogin($sunnet_utils.MOO_Names[1], "RLOGIN", tmp2); for x in (this.login_hooks) if ($object_utils:has_callable_verb(x, verb)) x:(verb)(@args); endif endfor else raise(E_PERM); endif "Last modified Thu Jan 3 15:25:35 2002 CST by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_fo, "rlogin") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "rlogin"}, {"this", "none", "this"})'; .program $sunnet_fo:rlogin "SunNET 3.0a2"; if ($perm_utils:controls(caller_perms(), this)) arguments = {args[1], @args[3], ctime()}; whotell = this:rlogin_notifiers(args[3][2], args[1]); for x in (whotell) this:rlogin_tell(x, @arguments); ticks_left() < 2000 || seconds_left() < 2 && suspend(0); endfor "Update RWHO cache"; {from, protocol, msg, @rest} = args; {wname, who, status, total, where, wherename, site} = msg; key = tostr("RINFO|", from, "|RWHO"); data = $sunnet_db:find_exact(key); if (typeof(data) != OBJ) {time, nums, lst} = data; "let's see.. RINFO|SiteName|RWHO stores data in the following form:"; " {time(), {total, active}, {{who, who.name, connected, "; " connected ? idle_seconds | last_disconnect_time, "; " connected_seconds or \"NOT CONNECTED\", location"; " location:who_location_msg(who)},...} }"; if (status in {"disconnected", "client_disconnected"}) if (i = $list_utils:iassoc(who, lst)) lst = listdelete(lst, i); endif elseif (status in {"created", "connected"}) if (i = $list_utils:iassoc(who, lst)) lst[i] = {who, wname, 1, 0, 0, where, wherename}; else lst = {@lst, {who, wname, 1, 0, 0, where, wherename}}; endif elseif (status in {"reconnected"}) if (i = $list_utils:iassoc(who, lst)) lst[i] = {who, wname, 1, 0, 0, where, wherename}; else lst = {@lst, {who, wname, 1, 0, 0, where, wherename}}; endif endif active = 0; for x in (lst) {who, name, connected, idle, connected, loc, locname} = x; if (connected && idle < $sunnet_protocols.active_threshold) active = active + 1; endif endfor data = {time, {length(lst), active}, lst}; $sunnet_db:insert(key, data); endif else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "init_for_core") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "init_for_core"}, {"this", "none", "this"})'; .program $sunnet_fo:init_for_core "SunNET 3.0a2"; if ($perm_utils:controls(caller_perms(), this)) this.login_hooks = {}; this.private_site_info = 1; $sunnet:add_protocol("RLOGIN", this, "rlogin"); return pass(@args); else raise(E_PERM); endif "Last modified Mon Oct 8 22:56:08 2001 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_fo, "rlogin_tell") ! E_VERBNF => add_verb($sunnet_fo, {player, "rx", "rlogin_tell"}, {"this", "none", "this"})'; .program $sunnet_fo:rlogin_tell "SunNET 3.0a2"; " You can customize your login watcher messages by adding/modifying "; "the following two properties on your player object using the"; "substitutions given below:"; " .login_msg - For local MOO logins."; " .rlogin_msg - For remote MOO logins."; ""; "List of substitutions:"; " %N Name of connecting player"; " %# Number of connecting player"; " %F Name of MOO player has connected on"; " %T Total at remote MOO"; " %D Date and time (see ctime())"; " %A Connecting or disconnecting"; " %L Location"; " %L# Location Number"; " %S Connection Site (obviously this is for wizards only)"; if ($perm_utils:controls(caller_perms(), this)) if (args[2] in $sunnet_utils.moo_names) if ($object_utils:has_property(who = args[1], "login_msg") && (tmp = who.login_msg) && typeof(tmp) == STR) msg = who.login_msg; else msg = "<== %A: %N, Total: %T ==>"; endif else if ($object_utils:has_property(who = args[1], "rlogin_msg") && (tmp = who.rlogin_msg) && typeof(tmp) == STR) msg = who.rlogin_msg; else msg = "<== %A: %N@%F, Total: %T ==>"; endif endif args = listdelete(args, 1); subs = {"%F", "%N", "%#", "%A", "%T", "%L#", "%L", "%S", "%D"}; if (!who.wizard) args["%S" in subs] = "Wouldn't You Like to Know!!"; endif for x in [1..length(subs)] subs[x] = {subs[x], args[x]}; endfor for x in (subs) msg = strsub(msg, x[1], tostr(x[2])); endfor who:notify(msg); endif "Last modified Fri Oct 25 10:37:58 2002 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_fo, "@rlogin") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "@rlogin @login"}, {"any", "any", "any"})'; .program $sunnet_fo:@rlogin "SunNET 3.0a2"; "USAGE: @login on/off Turn the login watcher on or off."; " @login all Listen to all logins."; " @login local Listen only to your local MOO's logins"; " @login interesting Listens to intersting player logins"; " @login interesting players Same as @login interesting"; " @login interesting moos Listen only to moos that you"; " either an interesting list for or"; " those in your moo list"; " @login public Toggles public access to your"; " interesting list. By default your"; " list should be private information."; " @login update Update your interesting lists"; " @login status Show current status of Login Watcher"; " @login verbose Toggle between showing this annoying"; " message when you make a mistake and"; " showing your status only you make"; " a mistake."; " @login help Show this message"; ""; "NOTES:"; " \"int\" can be used in place of \"interesting\" . . ."; " Options to disable guest and avatar logins will be added in the future"; ""; "Problems or suggestions can be directed to SunWiz."; if ($perm_utils:controls(caller_perms(), player)) "All this verb should do is extract the new flags from argstr then set"; "them and call this:update_lists(player); "; flags = nflags = this:get_player_flags(player); if ("on" in args) if (!("ON" in nflags)) nflags = setremove(nflags, "OFF"); nflags = setadd(nflags, "ON"); player:notify("Login Watcher turned on."); else player:notify("The Login Watcher IS on."); endif elseif ("off" in args) if (!("OFF" in nflags)) nflags = setremove(nflags, "ON"); nflags = setadd(nflags, "OFF"); player:notify("Login Watcher turned off."); else player:notify("The Login Watcher IS off."); endif elseif ("all" in args) if (!("ALL" in nflags)) player:notify("Adding ALL flag."); nflags = setadd(nflags, "ALL"); endif for x in ({"PLAYERS", "MOOS", "LOCAL"}) if (x in nflags) player:notify(tostr("Removing ", x, " flag.")); nflags = setremove(nflags, x); endif endfor elseif ("local" in args) if (!("LOCAL" in nflags)) player:notify("Adding LOCAL flag"); nflags = setadd(nflags, "LOCAL"); endif if ("ALL" in nflags) player:notify("Removing ALL flag."); nflags = setremove(nflags, "ALL"); endif elseif ((i = "interesting" in args) || (i = "int" in args)) args = listdelete(args, i); if (!args) args = {"PLAYERS"}; endif f = ""; if ("PLAYERS" in args) f = "PLAYERS"; elseif ("MOOS" in args) f = "MOOS"; endif if (f) if (!(f in nflags)) player:notify(tostr("Adding ", f, " flag")); nflags = setadd(nflags, f); endif for x in (setremove({"LOCAL", "ALL", "MOOS", "PLAYERS"}, f)) if (x in nflags) player:notify(tostr("Removing ", x, " flag.")); nflags = setremove(nflags, x); endif endfor else player:notify(tostr("Sorry, I do not understand, ", toliteral(argstr), ".")); if (!("VERBOSE" in nflags)) return player:tell_lines($code_utils:verb_documentation()); endif endif elseif ("update" in args) player:notify("Updating lists . . ."); this:update_lists(player); elseif ("verbose" in args) if ("VERBOSE" in nflags) player:notify("You will receive the help screen when mistyping options."); nflags = setremove(nflags, "VERBOSE"); else player:notify("You will receive only a message and the status screen when mistyping options."); nflags = setadd(nflags, "VERBOSE"); endif elseif ("public" in args) if ("PUBLIC" in nflags) player:notify("Your interesting list is now privatly readable by you."); nflags = setremove(nflags, "PUBLIC"); else player:notify("Your interesting list is now publically readable."); nflags = setadd(nflags, "PUBLIC"); endif elseif ("status" in args) "Do nothing. Status is shown at the end of the verb."; elseif ("help" in args) return player:tell_lines($code_utils:verb_documentation()); else argstr && player:notify(tostr("Sorry, I do not understand, ", toliteral(argstr), ".")); if (!("VERBOSE" in nflags)) return player:tell_lines($code_utils:verb_documentation()); endif endif if (flags != nflags) this:set_player_flags(player, nflags); if (setremove(flags, "VERBOSE") != setremove(nflags, "VERBOSE")) player:notify("Updating interesting player lists..."); this:update_lists(player, flags, nflags); endif endif player:notify(tostr("Login Watcher Status... Login watcher is turned ", (off = "OFF" in nflags) ? "Off" | "On", ".")); off && player:notify("However, if it were turned on your status would be:"); players = "PLAYERS" in nflags; moos = "MOOS" in nflags; local = "LOCAL" in nflags; all = "ALL" in nflags; all = local || players || moos ? 0 | all; moos = players ? 0 | moos; local = moos || players || all ? local | (moos = 1); if (local && moos) msg = "all local"; elseif (local && players) msg = "local interesting"; elseif (moos) msg = "interesting moo"; elseif (players) msg = "interesting player"; else msg = "all"; endif msg = tostr("You are currently listening to ", msg, " logins"); player:notify(msg); else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "@rinteresting") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "@rinteresting @interesting @runinteresting @uninteresting"}, {"any", "any", "any"})'; .program $sunnet_fo:@rinteresting "SunNET 3.0a2"; "USAGE: @interesting Add player on the local moo to your"; " intersting list. ( may be preceded"; " by a + symbol)"; " @interesting @ Add at to your"; " interesting list. ( may by"; " preeded by a + symbol)"; " @interesting @ Add to your interesting list."; ""; " -> Adding a ! or - symbol to any of the above <-"; " -> options will have the same effect as if the <-"; " -> command @uninteresting were typed without <-"; " -> the symbol. Used as a quick way to remove <-"; " -> players or moos in the same command. <-"; ""; " @uninteresting -- Uses the same forms as @interesting except that"; " The players or moos are removed from the"; " interesting list and that the + symbol "; " reverses the command as ! or - does for"; " @interesting."; ""; " -> With both commands, more than one player or <-"; " -> MOO pair may be specified. Questions or <-"; " -> Comments should be directed to SunWiz. <-"; ""; if ($perm_utils:controls(caller_perms(), player)) ""; "Some of the functionality in this verb will change with the new SunNET."; ""; flags = this:get_player_flags(player); if ("help" in args) return player:tell_lines($code_utils:verb_documentation()); endif if (argstr) removes = adds = {}; defaultadd = verb in {"@rinteresting", "@interesting"}; for x in (args) if (x[1] == "!" || x[1] == "-") removes = {@removes, x[2..length(x)]}; elseif (x[1] == "+") adds = {@adds, x[2..length(x)]}; elseif (defaultadd) adds = {@adds, x}; else removes = {@removes, x}; endif endfor for xx in ({@adds, @removes}) x = xx; t = rindex(x, "@"); if (!t) x = x + "@" + $sunnet_utils.moo_names[1]; endif if ((t = rindex(x, "@")) && t != length(x)) if (t > 1) who = x[1..t - 1]; else who = ""; endif moo = x[t + 1..length(x)]; if ((tmp = moo in $sunnet_utils.moo_names ? $sunnet_utils.moo_names[1] | $sunnet_utils:true_name(moo, 1)) == $failed_match) player:tell(toliteral(moo), " is not the name of a connected MOO."); else moo = tmp; if (who) tmp = $sunnet_utils:verb_call(moo, "$string_utils", "match_player", who); if (tmp[1]) if (tmp[2] == $failed_match) player:tell(toliteral(who), " is not the name of any player at ", moo, "."); elseif (tmp[2] == $ambiguous_match) player:tell(toliteral(who), " can refer to more than one player at ", moo, "."); else "add or remove the player as needed."; who = tmp[2]; if (xx in adds) this:add_interesting_data(player, who, moo); else this:remove_interesting_data(player, who, moo); endif endif else player:tell("There was a problem accessing ", moo, ". Try again later, perhaps the remote site is lagging."); endif else "add or remove the moo as needed."; if (xx in removes && (length(this:get_interesting_list(player, moo)) == 0 || $command_utils:yes_or_no("Are you sure you want to delete your entire interesting list from " + moo + "."))) this:remove_interesting_data(player, "", moo); elseif (xx in adds) this:add_interesting_data(player, "", moo); endif endif endif else player:notify("Sorry, couldn't understand: " + toliteral(xx) + "."); endif endfor endif data = this:get_interesting_list(player); if (data) player:tell("Validating interesting list...make take a few minutes to complete."); for x in (data) {site, @interesting} = x; result = $sunnet_utils:eval(site, ";return $list_utils:map_builtin(" + toliteral(interesting) + ", \"is_player\");"); if (result[1]) result = result[2]; for y in [1..length(interesting)] if (!result[y]) player:tell(who = interesting[y], "@", site, " is no longer a player.. removing from your interesting list."); this:remove_interesting_data(player, who, site); endif ticks_left() < 4000 || seconds_left() < 2 && suspend(0); endfor else player:tell(result[2]); endif endfor player:tell("You think the following MOOs and players are interesting."); for x in (data) player:tell(x[1]); if (length(x) > 1) player:tell($string_utils:space(length(x[1]), "-")); player:tell(" " + $sunnet_utils:verb_call(x[1], "$string_utils", "nn_list", listdelete(x, 1))[2]); endif endfor else player:tell("You do not think any `mooer' is interesting."); endif else raise(E_PERM); endif "Last modified Sun Sep 12 12:49:14 1999 CDT by SunWizard, #117@Rupert."; . ;`verb_info($sunnet_fo, "get_player_flags") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "get_player_flags"}, {"this", "none", "this"})'; .program $sunnet_fo:get_player_flags "SunNET 3.0a2"; data = $sunnet_db:find(tostr("R|F|", args[1])); if (caller == this || "PUBLIC" in data || $perm_utils:controls(caller_perms(), args[1])) return typeof(data) == LIST ? data | {"OFF"}; else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "set_player_flags") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "set_player_flags"}, {"this", "none", "this"})'; .program $sunnet_fo:set_player_flags "SunNET 3.0a2"; ":set_player_flags(who, flaglist);"; "Flag values:"; " ON Login watcher is turned on"; " OFF Login watcher is turned off.. this overrides ON"; " LOCAL Local logins only overrides remote PLAYERS and remote MOOS"; " PLAYERS Listening to interesting players"; " MOOS Listening to interesting MOOs"; " ALL Listing to all logins.. This is overriden by everything else"; " VERBOSE if this is missing, show help when typoes are made else show"; " status"; return caller == this || $perm_utils:controls(caller_perms(), args[1]) ? $sunnet_db:insert(tostr("R|F|", args[1]), args[2]) | E_PERM; . ;`verb_info($sunnet_fo, "get_interesting_moos") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "get_interesting_moos"}, {"this", "none", "this"})'; .program $sunnet_fo:get_interesting_moos "SunNET 3.0a2"; if (caller == this || "PUBLIC" in $sunnet_db:find(tostr("R|F|", args[1])) || $perm_utils:controls(caller_perms(), args[1])) data = this:get_interesting_list(args[1]); tmp = $list_utils:slice(data); "if there is an entry for moos, use it"; data = (tmp2 = "moos" in tmp) ? listdelete(data[tmp2], 1) | tmp; "if the entry for moos is empty, use the interesting MOOs list"; return !data ? listdelete(tmp, tmp2) | data; else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "get_interesting_list") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "get_interesting_list"}, {"this", "none", "this"})'; .program $sunnet_fo:get_interesting_list "SunNET 3.0a2"; if (caller == this || "PUBLIC" in $sunnet_db:find(tostr("R|F|", args[1])) || $perm_utils:controls(caller_perms(), args[1])) data = $sunnet_db:find(tostr("R|I|", args[1])); return length(args) == 1 ? typeof(data) == LIST ? data | {} | (typeof(data) == LIST && (tmp = args[2] in $list_utils:slice(data)) ? listdelete(data[tmp], 1) | {}); else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "update_lists") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "update_lists"}, {"this", "none", "this"})'; .program $sunnet_fo:update_lists "SunNET 3.0a2"; ":update_lists(player);"; "A foreseeably slow verb that will first remove the player from all"; "notification lists, then add player back depending on the interesting"; "list and flags."; if (caller == this || $perm_utils:controls(caller_perms(), args[1])) who = args[1]; flags = this:get_player_flags(who); "First let's create the lists that the player /should/ be on."; off = "OFF" in flags; players = "PLAYERS" in flags; moos = "MOOS" in flags; local = "LOCAL" in flags; all = "ALL" in flags; all = local || players || moos ? 0 | all; moos = players ? 0 | moos; local = moos || players || all ? local | (moos = 1); lst = {}; if (!off) if (local && moos) lst = {tostr("R|L|", $sunnet_utils.moo_names[1])}; elseif (local && players) for w in (this:get_interesting_list(who, $sunnet_utils.moo_names[1])) lst = setadd(lst, tostr("R|L|", $sunnet_utils.moo_names[1], "|", w)); ticks_left() < 4000 || seconds_left() < 2 && {player:notify(tostr("...building ", w)), suspend(0)}; endfor elseif (moos) for moo in (this:get_interesting_moos(who)) lst = setadd(lst, tostr("R|L|", moo)); ticks_left() < 4000 || seconds_left() < 2 && {player:notify(tostr("...building ", moo)), suspend(0)}; endfor elseif (players) for x in (this:get_interesting_list(who)) moo = x[1]; if (moo != "moos") for w in (listdelete(x, 1)) lst = setadd(lst, tostr("R|L|", moo, "|", w)); ticks_left() < 4000 || seconds_left() < 2 && {player:notify(tostr("...building ", w, "@", moo)), suspend(0)}; endfor endif ticks_left() < 4000 || seconds_left() < 2 && {player:notify(tostr("...building ", moo)), suspend(0)}; endfor else lst = {"R|A"}; endif endif "now check the lists, ignoring interesting lists and flags."; for c in (setadd($sunnet_db:find_all_keys("R|L"), "R|A")) if (index(c, "R|I|") == 1) elseif (index(c, "R|F|") == 1) else data = ndata = $sunnet_db:find(c); ndata = typeof(ndata) == LIST ? ndata | {}; if (!(c in lst)) ndata = setremove(ndata, who); endif if (ndata) data != ndata && $sunnet_db:insert(c, ndata); else $sunnet_db:delete(c); endif endif ticks_left() < 4000 || seconds_left() < 2 && {player:notify(tostr("...fixing ", c)), suspend(0)}; endfor for x in (lst) data = ndata = $sunnet_db:find(x); ndata = typeof(ndata) == LIST ? ndata | {}; ndata = setadd(ndata, who); if (ndata) data != ndata && $sunnet_db:insert(x, ndata); else $sunnet_db:delete(x); endif ticks_left() < 4000 || seconds_left() < 2 && {player:notify(tostr("...fixing ", x)), suspend(0)}; endfor else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "add_interesting_data") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "add_interesting_data"}, {"this", "none", "this"})'; .program $sunnet_fo:add_interesting_data "SunNET 3.0a2"; ":add_interesting_data(player, who, moo);"; "if moo is missing, then local moo is used."; "Who must be an object number, if it is not, then the entire moo is marked"; "as interesting. Don't forget to update the watch lists!"; if (caller == this || $perm_utils:controls(caller_perms(), args[1])) suspend(0); pl = args[1]; who = length(args) > 1 ? args[2] | ""; moo = length(args) > 2 ? args[3] | $sunnet_utils.moo_names[1]; data = this:get_interesting_list(pl); flags = this:get_player_flags(pl); if (typeof(who) == OBJ) if (ndx = moo in $list_utils:slice(data)) data[ndx] = setadd(data[ndx], who); else data = {@data, {moo, who}}; endif else if (ndx = "moos" in $list_utils:slice(data)) data[ndx] = setadd(data[ndx], moo); else data = {@data, {"moos", moo}}; endif endif if (!("OFF" in flags)) players = "PLAYERS" in flags; moos = "MOOS" in flags; local = "LOCAL" in flags; all = "ALL" in flags; all = local || players || moos ? 0 | all; moos = players ? 0 | moos; local = moos || players || all ? local | (moos = 1); if (local && moos) lst = tostr("L|", $sunnet_utils.moo_names[1]); elseif (local && players) lst = moo == $sunnet_utils.moo_names[1] ? tostr("L|", moo, "|", who) | ""; elseif (moos) lst = tostr("L|", moo); elseif (players) lst = tostr("L|", moo, "|", who); else lst = "A"; endif if (lst) plist = $sunnet_db:find(lst = tostr("R|", lst)); plist = setadd(typeof(plist) == LIST ? plist | {}, pl); $sunnet_db:insert(lst, plist); endif endif return $sunnet_db:insert(tostr("R|I|", pl), data); else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "remove_interesting_data") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "remove_interesting_data"}, {"this", "none", "this"})'; .program $sunnet_fo:remove_interesting_data "SunNET 3.0a2"; ":add_interesting_data(player, who, moo);"; "if moo is missing, then local moo is used."; "Who must be an object number, if it is not, then the entire moo is marked"; "as interesting. Don't forget to update the watch lists!"; if (caller == this || $perm_utils:controls(caller_perms(), args[1])) suspend(0); pl = args[1]; who = length(args) > 1 ? args[2] | ""; moo = length(args) > 2 ? args[3] | $sunnet_utils.moo_names[1]; data = this:get_interesting_list(pl); flags = this:get_player_flags(pl); lst = ""; if (typeof(who) == OBJ) if (ndx = moo in $list_utils:slice(data)) data[ndx] = setremove(data[ndx], who); if (length(data[ndx]) == 1) data = listdelete(data, ndx); endif lst = tostr("L|", moo, "|", who); endif else if (ndx = "moos" in $list_utils:slice(data)) data[ndx] = setremove(data[ndx], moo); if (length(data[ndx]) == 1) data = listdelete(data, ndx); endif lst = tostr("L|", moo); endif endif if (lst) plist = $sunnet_db:find(lst = tostr("R|", lst)); plist = setremove(typeof(plist) == LIST ? plist | {}, pl); plist ? $sunnet_db:insert(lst, plist) | $sunnet_db:delete(lst); endif return $sunnet_db:insert(tostr("R|I|", pl), data); else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "rlogin_notifiers") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "rlogin_notifiers"}, {"this", "none", "this"})'; .program $sunnet_fo:rlogin_notifiers "SunNET 3.0a2"; ":rlogin_notifiers(who, moo)"; "Who is going to get notified by this connection?"; if (caller == this || caller_perms().wizard) whotell = typeof(tmp = $sunnet_db:find("R|A")) == LIST ? tmp | {}; whotell = typeof(tmp = $sunnet_db:find(tostr("R|L|", args[2], "|", args[1]))) == LIST ? {@whotell, @tmp} | whotell; whotell = typeof(tmp = $sunnet_db:find(tostr("R|L|", args[2]))) == LIST ? {@whotell, @tmp} | whotell; return $set_utils:intersection(whotell, connected_players()); else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "feature_remove") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "feature_remove"}, {"this", "none", "this"})'; .program $sunnet_fo:feature_remove "SunNET 3.0a2"; if (caller == this || $perm_utils:controls(caller_perms(), args[1])) this:set_player_flags(who = args[1], {"OFF"}); this:update_lists(who); $sunnet_db:delete(tostr("R|I|", who)); $sunnet_db:delete(tostr("R|F|", who)); return `pass(@args) ! E_VERBNF => 0'; else raise(E_PERM); endif . ;`verb_info($sunnet_fo, "tell") ! E_VERBNF => add_verb($sunnet_fo, {player, "rxd", "tell notify"}, {"this", "none", "this"})'; .program $sunnet_fo:tell "SunNET 3.0a2"; player:(verb)(@args); . "********* "sunnet_scheduler "********* ;`property_info(#0, "sunnet_scheduler") ! E_PROPNF => add_property(#0, "sunnet_scheduler", `property_info(#0, "recycler") ! ANY => 0' ? $recycler:_create($generic_utils) | create($generic_utils), {player, "r"})'; ;$sunnet_scheduler.name = "SunNET Scheduler"; ;$sunnet_scheduler.aliases = {"SunNET Scheduler"}; ;$sunnet_scheduler.description = {"The scheduler is an efficient way to store repetitive tasks, or tasks that", "will fire (run) at a fairly long period of time in the future. For smaller", "intervals, of a few seconds, it is best to suspend then make the call.", "", "Some equivalents follow:", "", " The following:", "", " fork(