@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 = {"
", {"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, " | ", line};
endfor
return {hu:title(tostr($network.MOO_name, ": @who")), hu:center(hu:h1("@who")), @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, " | | Last Message | "};
lines = {@lines, "Mailing List | # Messages | Date | Sender |
"};
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, "
"};
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 = "Message | From | ";
for x in [1..this:length_all_msgs()]
$command_utils:suspend_if_needed(0);
message = this:messages_in_seq(x);
mail = tostr(mail, "", hu:anchor(tostr(message[1]), tostr(message[1], ". ", message[2][4])), " | ", hu:object_anchor($string_utils:rnn(message[2][2]), message[2][2]), " |
");
endfor
mail = tostr(mail, "
");
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"