@create $root_class named general web request handler,gwrh @prop #0."gwrh" #-1 rc ;;#0.("gwrh") = player:my_match_object("gwrh"); @prop $gwrh."help_crossindex_strings" {} rc ;;$gwrh.("help_crossindex_strings") = {{"see 'help %topic'", "see \"help %topic\"", "%topic"}, {"^%topic *-- ", "%topic -- ", "%topic"}, {"see also %topic", "see also %topic", "%topic"}, {"see `help %topic'", "see \"help %topic\"", "%topic"}, {"See also %topic", "See also %topic", "%topic"}, {"See \"help %topic\"", "See \"help %topic\"", "%topic"}, {"^%topic(.*) *-- ", "%topic -- ", "%topic()"}, {" in 'help %topic'", " in \"help %topic\"", "%topic"}, {"See `help %topic'", "See \"help %topic\"", "%topic"}, {"see 'help %topic(.*)'", "see \"help %topic()\"", "%topic()"}}; @prop $gwrh."sphere_vrml" {} rc ;;$gwrh.("sphere_vrml") = {"#VRML V1.0 ascii", "", "Separator {", " Info { ", " string \"Created by Eyeball Productions,Ltd. for Paper Software, Inc.\"", " }", "", " Info { ", " string \"Netscape Logo is a trademark of Netscape Communications, Inc.\"", " }", "", "", "#Setup camera", " PerspectiveCamera {", " position -100 -1000 110", " orientation 1 0 0 1.57 #4.712389", " focalDistance 5", " heightAngle .5", " #farDistance 1300", " #nearDistance 1", " }", "", " DirectionalLight {", " direction 0 1 0 # Light shining from viewer into scene", " intensity 1", " }", "", " MaterialBinding {", " value PER_FACE_INDEXED", " }", " Material {", "# ambientColor [ 0.9 0.9 0.9, ]", " diffuseColor [ 0.9 0.9 0.9, ]", "# specularColor [ 1.0 1.0 1.0, ]", " }", "", " DEF Globe Separator {", "", " Material {", " ambientColor [ 0.0 0.0 0.0, ]", " diffuseColor [ 0.00 0.00 0.00, ]", " specularColor [ .1 .1 .1, ]", " }", " ", " Sphere { radius 100 }", " }", "", " DEF GradientGlobe Separator {", " Material {", " ambientColor [ 0.0 0.0 1.0, ]", " transparency .8", " diffuseColor [ 0.05 0.05 0.95, ]", " specularColor [ 1.0 1.0 1.0, ]", " }", "", " Rotation { rotation 1 0 0 1.57 }", " ", " Sphere { radius -200 }", "", "}", "}"}; @prop $gwrh."emoo_base_url" "http://emoo.imaginary.com:4243" rc @prop $gwrh."robots_disallow_urls" {} rc ;;$gwrh.("robots_disallow_urls") = {"/code/ # code listings for all program code in a MOO database. Dynamicly changing and generated.", "/file/ # disk files, these are private, lets not make them avaiable to search engines"}; @prop $gwrh."mail_exclude" {} rc ;;$gwrh.("mail_exclude") = {$quota_log, $new_prog_log, $new_player_log, $newt_log}; @prop $gwrh."country" {} rc @prop $gwrh."setup_skips_requests" {} rc ;;$gwrh.setup_skips_requests = {"file", "in-db-parser", "project_docs", "web_projects", "moomail"}; @verb $gwrh:"http_request" this none this rx @program $gwrh:http_request url = args[1]; request = strsub(url[1], "/", ""); da_method = tostr("html_", request); return this:(da_method)(url); . @verb $gwrh:"html_who" this none this rx @program $gwrh:html_who players = connected_players(); lines = {"", {"", line}; endfor return {hu:title(tostr($network.MOO_name, ": @who")), hu:center(hu:h1("@who")), @lines, "
Who", "Connected", "Idle", "Location"}}; hu = $html_utils; tu = $time_utils; for who in (players) line = {"" + hu:object_anchor(who), "" + tu:english_time(connected_seconds(who)), "" + tu:english_time(idle_seconds(who)), "" + hu:object_anchor(who.location)}; lines = {@lines, "
"}; . @verb $gwrh:"html_code" this none this rx @program $gwrh:html_code hu = $html_utils; "so only readable code is web accessible"; set_task_perms($no_one); verbstr = strsub(args[1][2], "/", ""); rangestr = strsub(args[1][3], "/", ""); if (!rangestr) range = {}; else range = $string_utils:explode(rangestr, "-"); range = {{tonum(range[1]), tonum(range[2])}}; endif verbref = $code_utils:parse_verbref(verbstr); verbref[1] = valid(x = this:match_object(verbref[1])) ? x | toobj(verbref[1]); arguments = hu:bold($string_utils:from_list(verb_args(@verbref), " "), hu:br()); try p = (info = verb_info(@verbref))[2]; except e (ANY) p = (info = {$no_one, "", ""})[2]; endtry perms = {}; if (index(p, "r")) perms = {@perms, "Readable"}; endif if (index(p, "x")) perms = {@perms, "Executable"}; endif if (0 && index(p, "d")) perms = {@perms, "Debug"}; endif perms = $string_utils:from_list(perms, " "); if (info[1].wizard) perms = tostr(perms || "None", hu:br(), hu:bold("This method executes with unrestricted permissions."), hu:br()); endif code = hu:verb_code(@verbref, @range); "index(verbref[2], \" \") && (verbref[2] = tostr(\"\\\"\", verb_info(@verbref)[3], \"\\\"\"));"; verbref[2] = verbverbref[2] = verb_info(@verbref)[3]; verbname = $string_utils:from_list({$wiz_utils:core_ref(verbref[1]), verbref[2]}, ":"); if (typeof(code) == ERR) if (code == E_PERM) return $httpd:status_forbidden({hu:heading2("That method is not publiclly accessible.")}); endif return $httpd:status_internal_error({hu:heading2(tostr("Code request generated error ", $error:err_str(code), " (", code, ")"))}); endif return {hu:title(tostr($httpd.MOOwebname, "'s ", verbname)), hu:center(hu:h1(hu:special_chars_sub(verbname))), hu:center(arguments), hu:center(perms), @code}; . @verb $gwrh:"match_object" this none this rx @program $gwrh:match_object return pass(@args, $hacker); . @verb $gwrh:"html_help" this none this rx @program $gwrh:html_help "Keep $help:get_topic and $code_utils:help_db_list from breaking. --Campbell"; player = $no_one; hu = $html_utils; what = strsub(args[1][2], "/", ""); title = hu:title(tostr("Help ", what)); base = hu:base(tostr("http://", $httpd.server_name, ":", $httpd.server_port, "/help/")); dblist = $code_utils:help_db_list($prog); result = $code_utils:help_db_search(what, dblist); if (!result) "This is not a regular help topic let's try object."; stuff = $wiz_utils:core_ref(valid(x = this:match_object(what)) ? x | toobj(what)); result = $code_utils:help_db_search(stuff, dblist); if (!result) return {title, hu:h1("Sorry."), tostr("No help was found on '", what, "'.")}; else what = stuff; endif endif if (result[1] == $ambiguous_match) title = tostr(title, hu:h1("Ambiguous Topic")); head = tostr("The topic name '", what, "' is ambiguous. I don't know which of the following topics you mean:"); text = {}; for x in (result[2]) text = {@text, hu:anchor(x, x)}; endfor return {title, base, head, hu:unordered_list(text)}; else db = result[1]; topic = result[2]; if (x = $code_utils:parse_verbref(topic)) x[1] = valid(y = this:match_object(x[1])) ? y | toobj(x[1]); topic = $string_utils:from_list({$wiz_utils:core_ref(x[1]), x[2]}, ":"); endif dblist = dblist[1 + (db in dblist)..length(dblist)]; if (1 == (text = db:get_topic(topic, dblist))) text = {tostr(hu:h1("Sorry."), "Help was found on '", what, "', but is unavailable on the web.")}; elseif (text) text = {hu:h3(tostr("Showing help on '", what, "'")), @this:help_to_html(hu:format_moo(text))}; endif return {title, base, @text}; endif . @verb $gwrh:"html_display" this none this rxd @program $gwrh:html_display su = $string_utils; hu = $html_utils; "so only pubicly readable stuff is web accessible"; set_task_perms($no_one); url = args[1]; if ((typeof(url[2]) == ERR) || (url[2] == "/")) html = {hu:title("The Database"), hu:center(hu:heading1("The Database")), "Please select an object to display", hu:p()}; lines = {}; for x in [#0..max_object()] if (valid(x)) y = su:matchable_string(x); anchor = tostr(x, " -- ", x.name, " (", y, ")"); link = tostr("/display/", strsub(y, "#", ""), "/"); line = hu:anchor(link, anchor); else line = tostr(x, " -- ", hu:bold("invalid")); endif lines = {@lines, line}; $command_utils:suspend_if_needed(0); endfor return {@html, @hu:unordered_list(lines)}; endif if (!`url[3] ! ANY') url = {@url, "/"}; endif url = listdelete(url, 1); object = strsub(url[1], "/", ""); options = strsub(url[2], "/", ""); object = valid(x = this:match_object(object)) ? x | toobj(object); valid_options = {"methods", "props", "view"}; if (!valid(object)) return $httpd:status_syntax_error(hu:heading4("Not a valid object.")); endif core_ref = tostr(su:matchable_string(object)); name = $string_utils:matchable_string(object); base = tostr("/display/", strsub(core_ref, "#", ""), "/"); if (!(options in valid_options)) lines = {hu:title(tostr("Object Display: ", name)), hu:center(hu:heading2(name)), hu:hr()}; lines = {@lines, "You can browse four different aspects of this object:"}; aspects = {hu:anchor(base + "view", "View"), hu:anchor(base + "methods", "Verbs"), hu:anchor(base + "props", "Properties")}; lines = {@lines, hu:ordered_list(aspects), hu:p(), "Please select one of the above links to further browse ", name}; return lines; endif if (options == "methods") methods = verbs(object); tmethods = length(methods); lines = {hu:table_row({"", hu:bold("Name"), hu:bold("Owner"), hu:bold("Perms"), hu:bold("Arguments")})}; su = $string_utils; utilargs = {"this", "none", "this"}; cmdargs = {"none", "none", "this"}; for method in [1..tmethods] imet = `verb_info(object, method) ! ANY'; amet = `verb_args(object, method) ! ANY'; if (amet == utilargs) amet = "utility"; elseif (amet == cmdargs) amet = "command"; else amet = hu:tt(su:from_list(amet, " ")); endif if (imet != E_PERM) methodstr = hu:special_chars_sub(strsub(su:first_word(imet[3])[1], "*", "")); code = tostr($wiz_utils:core_ref(object), ":", methodstr); line = {tostr(method), hu:anchor(strsub(tostr("/code/", code), "#", ""), code), hu:object_anchor(imet[1]), imet[2], amet}; else line = {tostr(method), hu:bold(tostr(E_PERM)), " ", " ", " "}; endif lines = {@lines, hu:table_row(line)}; $command_utils:suspend_if_needed(0); endfor lines = hu:table(lines, 1); return {"Verbs on ", tostr($wiz_utils:core_ref(object)), hu:p(), @lines}; elseif (options == "props") props = (`url[3] ! ANY' == "/all") ? $object_utils:all_properties_suspended(object) | `properties(object) ! E_PERM => {}'; props = $set_utils:difference(props, {@properties($root_class), "help_msg"}); tprops = length(props); lines = {hu:table_row({"", hu:bold("Name"), hu:bold("Owner"), hu:bold("Perms"), hu:bold("Value")})}; su = $string_utils; for prop in [1..tprops] propstr = props[prop]; ip = `property_info(object, propstr) ! E_PERM'; if (`is_clear_property(object, propstr) ! E_PERM') vp = hu:italics("(clear)"); clear = 1; else clear = 0; vp = `object.(propstr) ! E_PERM'; endif propstr = hu:special_chars_sub(tostr(".", propstr)); if (ip == E_PERM) line = {prop, propstr, " ", " ", hu:bold(tostr(E_PERM))}; else line = {prop, propstr, hu:object_anchor(ip[1]), ip[2], clear ? vp | hu:special_chars_sub(su:from_value(vp, 1, -1))}; endif lines = {@lines, hu:table_row(line)}; endfor lines = hu:table(lines, 1); return {"Properties on ", tostr($wiz_utils:core_ref(object)), hu:p(), @lines}; elseif (options == "view") names = $list_utils:remove_duplicates({object.name, @object.aliases}); owners = {object.owner, @(`object.owners ! E_PROPNF => {}')}; try props = length(properties(object)); except id (E_PERM) return $httpd:status_forbidden("The object you requested is unreadable"); endtry verbs = length(verbs(object)); try commands = length($commandspec_utils:commands(object)); except (E_PROPNF) "most likely error if we're not on E_MOO. --Campbell"; commands = 0; endtry su = $string_utils; p = hu:p(); webbed = hu:object_anchor(object); if (index(webbed, "", "This object is", object.r ? " " | " not ", "readable."}; lines = {@lines, "
", "This object is", object.w ? " " | " not ", "writable."}; lines = {@lines, "
", "This object is", object.f ? " " | " not ", "fertile."}; if (object.r) lines = {@lines, "Found ", tostr(props), " properties on this object, and ", tostr(verbs), " verbs."}; endif return {hu:title(core_ref), hu:center(hu:heading1(core_ref)), @lines}; endif . @verb $gwrh:"html_file" this none this rx @program $gwrh:html_file fn = listdelete(args[1], 1); "only publiclly readable files"; set_task_perms($no_one); if (fn[1] == "/tail") tail = 1; fn = listdelete(fn, 1); endif fn = tostr(@fn); filename = $file_utils:parse_path(fn); hu = $html_utils; if (!$file_utils:exists(@filename)) return $httpd:status_not_found(hu:heading3("The specified file doesn't exist or is inaccessible.")); endif if (index(filename[2], ".html")) return $file_utils:read(@filename); else lines = hu:pre($file_utils:read(@filename, @tail ? {max($file_utils:length(@filename) - 100, 1)} | {})); return {hu:title(fn), hu:center(hu:heading2(fn)), hu:hr(), tail ? "..." | "", lines}; endif . @verb $gwrh:"html_people" this none this rx #2 @program $gwrh:html_people hu = $html_utils; title = tostr("The People of ", $network.MOO_name); p = "

"; lines = {hu:title(title), hu:center(hu:heading1(title))}; lines = {@lines, hu:heading3(tostr(hu:anchor("/who/", "Who"), " is online?")), p}; lines = {@lines, hu:heading3(tostr("People who have home pages here on ", $network.MOO_name, ":"))}; links = {}; request_method_name = $httpd.request_method_name; for who in ($list_utils:sort(players())) if ($object_utils:has_callable_verb(who, request_method_name)) links = {@links, {hu:object_anchor(who), who:description()}}; endif endfor if (links) links = hu:def_list(links); endif lines = {@lines, @links}; return lines; . @verb $gwrh:"html_vrml" this none this rx @program $gwrh:html_vrml httpd = $httpd; url = listdelete(args[1], 1); vrml_object = strsub(url[1], "/", ""); object = this.(tostr(vrml_object, "_vrml")); if (typeof(object) == ERR) return httpd:status_not_found(); endif return httpd:content_type("x-world/x-vrml", object); object = {httpd:response_header_date(), httpd:response_header_server(), httpd:("response_header_content-type")("x-world/x-vrml"), "", @object}; return httpd:status_ok(@object); . @verb $gwrh:"help_to_html" this none this rx #2 @program $gwrh:help_to_html ":help_to_html ( text )"; ""; "Tries to convert help text to a cross referenced html document"; "currently searches for \"see 'help xxx'\""; " \"topic-name -- \" at the start of a line"; hu = $html_utils; su = $string_utils; lines = {@$list_utils:flatten(args), ""}; lookfors = this.help_crossindex_strings; for line in [1..length(lines)] "horizontial rules replace lines of -'s that are the same length as the previous line"; if ((length(lines[line]) == (p = length(lines[line + 1]))) && index(lines[line + 1], "----")) lines[line..line + 1] = {hu:center(hu:heading2(lines[line])), hu:hr()}; endif "The following matches numbered lists and turns them into html ordered lists"; "doesn't handle nested lists very well, will colapse them into one"; if (x = match(lines[line], "^ *[1234567890]+%. ")) if (!ol_start) ol_start = line; endif last_is_ol = 1; lines[line][1..index(lines[line], ".")] = ""; elseif (last_is_ol) lines[ol_start..line - 1] = hu:ordered_list(lines[ol_start..line - 1]); last_is_ol = ol_start = 0; endif "Now we do the links to other help topics"; for lookfor in (lookfors) x = strsub(lookfor[1], "%topic", "%([-a-zA-Z_@#%$( ]+%)"); while (x = match(lines[line], x, 1)) where = x[3][1]; topic = su:trim(lines[line][where[1]..where[2]]); html_link = strsub(lookfor[3], "%topic", topic); topic = hu:anchor(tostr("/help/", html_link), topic); lines[line][x[1]..x[2]] = tostr(strsub(lookfor[2], "%topic", topic)); endwhile endfor prevlen = length(lines[line]); endfor return lines; . @verb $gwrh:"html_in-db-parser html_project_docs html_web_projects html_moo_stuff html_moomail html_E_WEB_registry" this none this rxd @program $gwrh:html_in-db-parser "This verb will redirect the browser to E_MOO; we don't want to have any out-of-date stuff here. --Campbell"; return $httpd:status_redirect(tostr(this.emoo_base_url, $string_utils:from_list(args[1], ""))); . @verb $gwrh:"html_robots.txt" this none this rxd #2 @program $gwrh:html_robots.txt lines = {tostr("# robots.txt file for ", $httpd:complete_url("/")), ""}; lines = {@lines, "User-Agent: * # bar all robots"}; for line in (this.robots_disallow_urls) lines = {@lines, tostr("Disallow: ", line)}; endfor lines = {$httpd:response_header_date(), $httpd:response_header_server(), $httpd:response_header_content_type("text/plain"), "", @lines}; return $httpd:status_ok(lines); . @verb $gwrh:"html_mail" this none this rxd @program $gwrh:html_mail "Keep $mail_agent:msg_summary_line from breaking. --Campbell"; player = $no_one; hu = $html_utils; title = tostr($network.MOO_name, "'s Mailing Lists"); lines = {hu:title(title), hu:center(hu:heading1(title))}; lines = {@lines, tostr("Welcome to ", $network.MOO_name, "'s mail list interface. Those lists")}; lines = {@lines, "that are not linked are not publicly readable.

"}; lines = {@lines, ""}; lines = {@lines, ""}; lines = {@lines, ""}; for x in ($object_utils:leaves($mail_recipient)) if (x.messages && (!(x in this.mail_exclude))) if (x.readers == 1) name = hu:object_anchor(x, x:title()); else name = x:title(); endif msgs = x:length_all_msgs(); info = x:messages_in_seq(x:parse_message_seq({"last:1"}, {0})[1]); summary = hu:special_chars_sub(x:msg_summary_line(@info[1][2])); lines = {@lines, hu:table_row({name, msgs, summary[1..15], summary[16..37]})}; endif endfor lines = {@lines, "
Last Message
Mailing List# MessagesDateSender
"}; return lines; . @verb $gwrh:"web_objects_setup" this none this rxd @program $gwrh:web_objects_setup "Written by Matthew Campbell to set up $web_objects after $gwrh is installed."; $perm_utils:controls(caller_perms(), $web_objects) || raise(E_PERM); for vrb in (verbs(this)) for vrbname in ($string_utils:words(vrb)) if (`vrbname[1..5] ! E_RANGE' == "html_" && !((request = vrbname[6..$]) in this.setup_skips_requests)) try add_property($web_objects, request, this, {$web_objects.owner, "rc"}); except (E_INVARG) "property already exists, most likely"; $web_objects.(request) = this; endtry endif endfor endfor . @verb $mail_recipient:"http_request" this none this rxd @program $mail_recipient:http_request if (this.readers != 1) return $httpd:error_not_found(); endif hu = $html_utils; url = listdelete(args[1], 1); title = hu:title(this:title()); base = hu:base(tostr("http://", $httpd.server_name, ":", $httpd.server_port, hu:object_ref(this))); header = {hu:h1(this:title()), $list_utils:flatten({this:description()}), hu:hr()}; "check for specific mail message"; if ((length(url) == 0) || ((length(url) == 1) && (url[1] == "/"))) mail = ""; for x in [1..this:length_all_msgs()] $command_utils:suspend_if_needed(0); message = this:messages_in_seq(x); mail = tostr(mail, ""); endfor mail = tostr(mail, "
MessageFrom
", hu:anchor(tostr(message[1]), tostr(message[1], ". ", message[2][4])), "", hu:object_anchor($string_utils:rnn(message[2][2]), message[2][2]), "
"); return {title, base, header, mail}; endif message = strsub(url[1], "/", ""); if (!(message = $code_utils:tonum(message))) return $httpd:error_not_found(); endif if (!(x = this:exists_num_eq(message))) mail_text = {tostr(this:title(), " has no message numbered ", message, ".")}; else mail_text = $mail_agent:to_text(@this:messages_in_seq(x)[2]); endif title = hu:title(tostr(this:title(), ": Message ", message)); last = hu:anchor(tostr(hu:object_ref(this), (message > 1) ? message - 1 | 1), hu:image("marble_left_arrow.gif", "[Last Page]")); next = hu:anchor(tostr(hu:object_ref(this), message + 1), hu:image("marble_right_arrow.gif", "[Next Page]")); return {title, base, header, hu:h3(tostr("Message ", message, ":")), @hu:pre(mail_text), last, next}; . @verb $string_utils:"rnn" this none this rxd @program $string_utils:rnn "reverses the effects of name_and_number. Pass it a string containing a name and number and get an object in return."; return (x = match(args[1], ".* (%(#[0-9]+%))")) ? toobj(args[1][x[3][1][1]..x[3][1][2]]) | $nothing; . ;;$gwrh:web_objects_setup(); ;"***Finished"