@create $container named HTTP Server,httpd @prop #0."httpd" #-1 rc ;;$httpd = player:my_match_object("httpd"); @create $generic_db named HTTP Environment DB,http_env_db @create $generic_db named HTTP Log DB,http_log_db @prop $server_options.network_buffer_size 16384 rc @prop $httpd."current_connections" {} rc @prop $httpd."error_not_found" {} rc ;;$httpd.("error_not_found") = {"

Error 404


The requested object was not found on this server.


"} @prop $httpd."request_method_name" "http_request" rc @prop $httpd."version" "E_WEB (E_MOO-Web-Server/1.2c - Not WOO)" rc @prop $httpd."url_special_chars" {} rc ;;$httpd.("url_special_chars") = {{"%20", " "}, {"%21", "!"}, {"%22", "\""}, {"%23", "#"}, {"%24", "$"}, {"%26", "&"}, {"%27", "'"}, {"%2A", "*"}, {"%2C", ","}, {"%2F", "/"}, {"%3A", ":"}, {"%3C", "<"}, {"%3D", "="}, {"%3E", ">"}, {"%3F", "?"}, {"%5B", "["}, {"%5C", "\\"}, {"%5D", "]"}, {"%5E", "^"}, {"%60", "`"}, {"%7B", "{"}, {"%7D", "}"}, {"%7E", "~"}, {"%25", "%"}, {"%28", "("}, {"%29", ")"}, {"%3B", ";"}} @prop $httpd."home_page_body" {} rc @prop $httpd."server_name" "" rc ;;$httpd.("server_name") = $network.site; @prop $httpd."server_port" 80 rc @prop $httpd."status_codes" {} rc ;;$httpd.("status_codes") = {{"post_success", "201 POST successful"}, {"batch", "202 batch job accepted"}, {"partial", "203 partial url"}, {"moved", "301 url moved"}, {"redirect", "302 redirection"}, {"not_changed", "304 no changes"}, {"syntax_error", "400 syntax error"}, {"need_authorization", "401 authorization required"}, {"need_chargeto", "402 chargeto field required"}, {"forbidden", "403 permission denied"}, {"not_found", "404 url not found"}, {"internal_error", "500 internal error"}, {"unsupported_method", "501 unimplemented method"}}; @prop $httpd."connection_count" 0 rc @prop $httpd."graphics_root" "" rc @prop $httpd."env_db" #-1 rc ;;$httpd.("env_db") = player:my_match_object("http_env_db"); @prop $httpd."log_db" #-1 rc ;;$httpd.("log_db") = player:my_match_object("http_log_db"); @prop $httpd."log_file" "httpd/httpd.log" rc @prop $httpd."debug" 0 rc @prop $httpd."msg_footer" "" rc @prop $httpd."supported_methods" {} r ;;$httpd.("supported_methods") = {"GET", "HEAD", "POST"} @prop $httpd."webmaster" "" rc @prop $httpd."MOOwebname" "" rc ;;$httpd.("MOOwebname") = $network.MOO_name; ;;$httpd:set_aliases({"HTTP Server"}); ;;$httpd:set_description("Listens for connections on the MOO's web port and handles HTTP requests"); @verb $httpd:"do_login_command" this none this rx @program $httpd:do_login_command set_connection_option(player, "hold-input", 1); lines = {}; count = 1; su = $string_utils; while (line = read(player)) lines = {@lines, line}; if ((count == 1) && (length(su:words(line)) == 2)) "special catch for HTTP/0.9"; break; endif count = count + 1; endwhile try this:log_connection(lines); this:debug(length(lines), "read lines"); this:handle_request(lines); except exception (ANY) hu = $html_utils; lines = this:status_internal_error({hu:tt(":http_request"), " tracebacked with:
", @hu:pre($code_utils:format_traceback(@exception))}); lines = {@lines, this:page_footer()}; this:notify_connection(lines); endtry return 0; . @verb $httpd:"start_listening" this none this rxd @program $httpd:start_listening caller_perms().wizard || raise(E_PERM); nt = $network; port = this.server_port; result = listen(this, port, 0); if (result == port) msg = tostr(nt.MOO_name, ": http://", nt.site, ":", port); else msg = tostr(this, ":", verb, ": Unable to listen on port ", port, "(", result, ")"); endif server_log(msg); return result; . @verb $httpd:"parse_url" this none this rx @program $httpd:parse_url ":path_to_list(path) - returns a URL path in the form of a list"; "Example: /users/Fabuley?Planet=Neptune = {/users, /Fabuley, ?Planet=Neptune}"; this:debug(args[1]); path = this:decode_url(args[1]); this:debug(path); plist = {}; while (path) q = rindex(path, "?"); s = rindex(path, "/"); delimit = (q > s) ? q | ((s > q) ? s | length(path)); plist = {@plist, path[delimit..length(path)]}; path = path[1..delimit - 1]; endwhile return $list_utils:reverse(plist); . @verb $httpd:"GET HEAD" this none this rx @program $httpd:GET this:debug(dobj, dobjstr); url = args; this:debug({player, url}); object = this:match_object(url[1]); if (!valid(object)) return this:status_not_found(); endif "Removed, since it was causing problems."; "This now means that objects can be referenced via /xxxx and /xxxx/, which causes a problem with .log_db"; "And people will have to remember that they won't always get a second part of the URL passed."; "Deal with it. The redirections were causing too much trouble."; "if ($web_objects:needs_trailing_slash(object) && length(url) == 1)"; " return this:status_redirect(tostr(dobjstr, \"/\"));"; "endif"; "Possible solution: Have the object determine itself if it needs a redirection, and return redirection headers"; " (via :status_redirection(), of course)"; lines = object:(this.request_method_name)(url); if (verb == "HEAD") lines = ((lines[1][1..4] == "HTTP") && (x = "" in lines)) ? lines[1..x] | this:status_ok(@this:response_headers_standard()); endif return lines; . @verb $httpd:"match_object" this none this rx @program $httpd:match_object object = strsub(args[1], "/", ""); if (!object) return $web_objects.default; endif if ($code_utils:tonum(object)) object = tostr("#", object); endif found = $web_objects.(object); if (typeof(found) == OBJ) return found; endif object = $string_utils:match_object(object, $player_start, this); if (valid(object) && (!$object_utils:has_verb(object, this.request_method_name))) return $failed_match; endif return object; . @verb $httpd:"notify_connection" this none this rx @program $httpd:notify_connection ":notify_connection( lines )"; "Sends lines to the connection, pausing when the buffer is full, and waiting to boot the connection until it's empty"; hu = $html_utils; lines = args; $command_utils:suspend_if_needed(0); lines = $list_utils:flatten_suspended(lines); size = {length(lines), this:requested_object_length(lines)}; "lines = this:requested_object_split(lines, buffer_threshold);"; this:debug(size); x = 0; "here's the trick, if the buffer is full, and we show no signs of it"; "getting reduced, we incrementally suspend for greater amounts of"; "time, upto a max of 10 seconds. Ideally, even a 14.4k connection"; "is fast enough that we should be constantly filling up the"; "buffer and suspending for less than 3 or 4 seconds each time"; "we need to suspend"; fork task (0) for line in (lines) suspend_time = iterations = 1; line = tostr(line); while (!notify(player, line, 1)) if ((iterations < 4) && (suspend_time <= 3)) suspend_time = suspend_time + 2; endif suspend(suspend_time); if (typeof(`idle_seconds(player) ! ANY') == ERR) boot_player(player); kill_task(task_id()); endif iterations = iterations + 1; endwhile endfor suspend_time = iterations = 1; "don't boot 'em until we are sure there is nothing left in the buffer"; while (buffered_output_length(player)) if ((iterations < 4) && (suspend_time <= 3)) suspend_time = suspend_time + 2; endif suspend(suspend_time); if (typeof(`idle_seconds(player) ! ANY') == ERR) boot_player(player); kill_task(task_id()); endif iterations = iterations + 1; endwhile boot_player(player); this:debug(tostr("terminated: ", task, " booted: ", player)); endfork if (caller != this) kill_task(task_id()); endif . @verb $httpd:"parse_request" this none this rx @program $httpd:parse_request words = $string_utils:words(args[1]); return {words[1], words[2]}; . @verb $httpd:"error_not_found" this none this rx @program $httpd:error_not_found return this.error_not_found; . @verb $httpd:"handle_request" this none this rx @program $httpd:handle_request if (caller != this) return E_PERM; endif lines = args[1]; method = lines[1]; data = listdelete(lines, 1); mw = $string_utils:words(method); {fs, ls, ?version} = mw; "fs = index(method, \" \");"; "ls = rindex(method, \" \");"; "mw = {method[1..fs - 1], method[fs + 1..ls - 1], method[ls + 1..$]};"; method = mw[1]; dobjstr = this:complete_url(mw[2]); url = this:parse_url(mw[2]); "record 'data' somehow"; $httpd:debug(lines); $httpd:debug(url); hu = $html_utils; if (method in this.supported_methods) try text = this:(method)(@url) || this:status_internal_error({hu:tt(":http_request"), " returned a false value.", hu:i("(unprogrammed or badly programmed)")}); except exception (ANY) tb = $code_utils:format_traceback(@exception); for x in [1..length(tb)] y = tb[x]; if (index(y, ":")) m = match(y, "%([^ ]+:[^, ]+%)"); z = substitute("%1", m); z = strsub(z, "#", ""); y[m[3][1][1]..m[3][1][2]] = z; tb[x] = y + "
"; endif endfor text = this:status_internal_error({hu:tt(method), " attempt tracebacked with:
", @hu:tt(tb), @this:page_footer()}); endtry else text = this:status_unsupported_method(); endif if (text[1][1..4] != "HTTP") "the player didn't use :status_* in their code, so we need to stick headers and a status on"; text = {this:response_headers_standard(), @text, @this:page_footer()}; text = this:status_ok(@text); endif this:notify_connection(text); return 0; . @verb $httpd:"http_request" this none this rx @program $httpd:http_request "default verb; it can be edited if you want"; "written by Campbell"; return this.home_page_body; . @verb $httpd:"requested_object_length" this none this rx @program $httpd:requested_object_length lines = args[1]; return length(tostr(@lines)) + length(lines); . @verb $httpd:"split_line" this none this rx @program $httpd:split_line len = length(line = args[1]); half = len / 2; front = line[1..half]; back = line[half + 1..len]; rspace = rindex(front, " "); back = tostr(line[rspace..half - 1], back); front = front[1..rspace]; return {front, back}; . @verb $httpd:"requested_object_split" this none this rxd @program $httpd:requested_object_split lines = args[1]; con = 1; buffer_size = args[2]; while (con <= length(lines)) line = tostr(lines[con]); if (length(line) > buffer_size) lines[con..con] = this:split_line(line); else con = con + 1; endif ((ticks_left() < 200) || (seconds_left() < 1)) && suspend(0); endwhile sizes = {}; for x in (lines) if (typeof(x) != STR) this:debug({x, callers()}); endif sizes = listappend(sizes, length(tostr(x))); endfor this:debug(sizes); return lines; . @verb $httpd:"debug" this none this rx @program $httpd:debug if (!this.debug) return args[1]; endif if (!args) args = {"trace"}; endif if (!valid(this.location)) return args[1]; endif if (length(args) > 1) msg = tostr(@listdelete(args, 1), ": "); else msg = tostr(caller, ":", callers()[1][2], "(): "); endif this.location:announce(tostr(msg, toliteral(args[1]))); return args[1]; . @verb $httpd:"status_ok" this none this rx @program $httpd:status_ok lines = {"HTTP/1.0 200 ok", @args}; return lines; . @verb $httpd:"httpd_version" this none this rx @program $httpd:httpd_version return tostr(this.version, " (LambdaMOO ", server_version(), ")"); . @verb $httpd:"decode_url encode_url" this none this rx @program $httpd:decode_url if (verb == "decode_url") return $string_utils:substitute(args[1], this.url_special_chars); else subs = $list_utils:map_to_method($list_utils, "_reverse", this.url_special_chars); return $string_utils:substitute(args[1], subs); endif . @verb $httpd:"POST" this none this rx @program $httpd:POST line = read(player); this:debug(line); line = this:decode_url(line); url = {@args, line}; this:debug({player, url}); object = this:match_object(url[1]); if (!valid(object)) return this:status_not_found(); endif "Removed, since it was causing problems."; "This now means that objects can be referenced via /xxxx and /xxxx/, which causes a problem with .log_db"; "And people will have to remember that they won't always get a second part of the URL passed."; "Deal with it. The redirections were causing too much trouble."; "if ($web_objects:needs_trailing_slash(object) && length(url) == 1)"; " return this:status_redirect(tostr(dobjstr, \"/\"));"; "endif"; "Possible solution: Have the object determine itself if it needs a redirection, and return redirection headers"; " (via :status_redirection(), of course)"; lines = object:(this.request_method_name)(url); return lines; . @verb $httpd:"status_redirect*ion" this none this rx @program $httpd:status_redirection lines = {"HTTP/1.0 302 redirection", "Server: " + this:httpd_version()}; lines = {@lines, "Location: " + args[1]}; return lines; . @verb $httpd:"status_*" this none this rx @program $httpd:status_ status_codes = this.status_codes; status_strings = $list_utils:slice(status_codes, 1); verb[1..7] = ""; rstatus = verb; type = status_codes[rstatus in status_strings][2]; hu = $html_utils; dobjstr = dobjstr || "unknown"; br = hu:br(); error_code = tostr(player, ":", time()); if (type) lines = {"HTTP/1.0 " + type}; lines = {@lines, tostr("Server: ", this:httpd_version())}; lines = {@lines, tostr("Date: ", this:time())}; lines = {@lines, "MIME-version: 1.0", "Content-type: text/html", ""}; lines = {@lines, hu:title(tostr("Error #", type, " (", dobjstr, ")"))}; lines = {@lines, hu:heading1(tostr("Error #", type)), "

"}; lines = {@lines, "URL requested: ", hu:bold(hu:tt(dobjstr)), br}; if (x = $httpd:get_env("REFERER")) lines = {@lines, "Refering URL: ", hu:bold(hu:tt(x)), br}; endif lines = {@lines, "Reference code: ", hu:bold(hu:tt(error_code)), "

"}; lines = {@lines, "If you feel that you shouldn't have gotten this error, please report it to "}; lines = {@lines, tostr("WebMaster.

")}; lines = {@lines, @args}; endif lines = lines || args; return lines; . @verb $httpd:"time" this none this rx @program $httpd:time time = (length(args) > 0) ? args[1] | time(); return $time_utils:time_sub("$d, $T $n $y $H:$M:$S $Z", time); return ctime(); . @verb $httpd:"complete_url" this none this rx @program $httpd:complete_url url = tostr("http://", this.server_name, ":", this.server_port, args[1] ? args[1] | "/"); return url; . @verb $httpd:"page_footer" this none this rx @program $httpd:page_footer nw = $network; hu = $html_utils; telnet = tostr("telnet://", nw.site, ":", nw.port); http = tostr("http://", nw.site, ":", this.server_port, "/"); telnet = hu:anchor(telnet, telnet); http = hu:anchor(http, http); "msg = this:msg_address_suffix_random();"; "msg = $local:goofy_saying();"; x = length(connected_players()); if (x == 0) on_line = "No one connected"; elseif (x == 1) on_line = "One user connected"; else on_line = tostr($string_utils:capitalize($string_utils:english_number(x)), " users connected"); endif lines = {"Logo coming soon!!!", tostr("
-- ", telnet, " -- ", hu:mailto(this.webmaster, "Mail us"), " -- ", http, " --
")}; lines = {@lines, tostr("-- ", hu:i(on_line), " --")}; lines = {hu:p(), hu:hr(), hu:center(hu:address(lines))}; if (x = this:msg_footer()) lines = {@lines, hu:center(hu:bold(tostr("Notice: ", x)))}; endif return lines; . @verb $httpd:"log_connection" this none this rxd @verb $httpd:"response_headers_standard" this none this rx @program $httpd:response_headers_standard return {this:response_header_date(), this:response_header_server(), "Content-type: text/html", ""}; . @verb $httpd:"response_header_server" this none this rx @program $httpd:response_header_server return tostr("Server: ", this:httpd_version()); . @verb $httpd:"response_header_date" this none this rx @program $httpd:response_header_date return "Date: " + this:time(); . @verb $httpd:"response_header_content-type response_header_content_type" this none this rx @program $httpd:response_header_content-type return tostr("Content-type: ", (length(args) > 0) ? args[1] | "text/html"); . @verb $httpd:"response_header_last-modified response_header_last_modified" this none this rx @program $httpd:response_header_last-modified return "Last-modified: " + this:time(); . @verb $httpd:"response_header_content-length response_header_content_length" this none this rx @verb $httpd:"get_env" this none this rx @program $httpd:get_env ":get_env ( variable )"; x = this.env_db:find(tostr(player)); request = args[1]; if (!x) "the requested connection was nonexistant, so all env settings would be clear"; return ""; endif variables = {"SERVER_SOFTWARE", "SERVER_NAME", "SERVER_PORT", "SERVER_PROTOCOL"}; values = {this:httpd_version(), this.server_name, tostr(this.server_port), "HTTP/1.0"}; if (y = request in variables) return values[y]; endif this:debug(x); f = $list_utils:slice(x, 1); y = request in f; return x[y][2] || ""; . @verb $httpd:"channel_xmit" this none this rx @program $httpd:channel_xmit connection = player; player = this; argstr = args[1]; #154:xmit("/web"); player = connection; . @verb $httpd:"content_type" this none this rx @program $httpd:content_type "$httpd:content_type(, )"; ""; "Returns with the correct headers for content-type "; type = args[1]; data = listdelete(args, 1); lines = {this:response_header_date(), this:response_header_server(), this:("response_header_content-type")(type), "", data}; return this:status_ok(@lines); . @create $root_class named HTML Utilities,html_utils @prop #0."html_utils" #-1 rc ;;$html_utils = player:my_match_object("html_utils"); @prop $html_utils."html_subs" {} rc ;;$html_utils.("html_subs") = {{"<", "<"}, {">", ">"}} ;;$html_utils.("aliases") = {"HTML Utilities"} @verb $html_utils:"heading*" this none this rx @program $html_utils:heading x = typeof(args[1]); mode = verb[length(verb)]; mode = tonum(mode); mode = ((0 < mode) && (mode < 7)) ? mode | 1; on = tostr(""); off = tostr(""); if (x == LIST) return {on, @args[1], off}; else return tostr(on, args[1], off); endif ">>>:TIME1.0: Compiled by ThwartedEfforts(#2) on Mon Jul 10 20:43:01 1995 MET DST"; . @verb $html_utils:"anchor anchor_href" this none this rx @program $html_utils:anchor ":anchor( link, content )"; link = args[1]; content = args[2] || link; return tostr("", content, ""); ">>>:TIME1.0: Compiled by Kangor (#235) on Tue Oct 10 02:56:50 1995 MET"; . @verb $html_utils:"HR horizontal_rule" this none this rx @program $html_utils:HR "$html_utils:hr( [ NUM size [, NUM width ]] )"; a = args[1] ? tostr(" size=", args[1]) | ""; b = args[2] ? tostr(" width=", args[2]) | ""; return tostr(""); ">>>:TIME1.0: Compiled by ThwartedEfforts(#2) on Thu Jul 6 00:54:14 1995 MET DST"; . @verb $html_utils:"address b i blockquote cite code em h1 h2 h3 h4 h5 h6 kbd samp strong title tt var center" this none this rx @program $html_utils:address on = tostr("<", verb, ">"); off = tostr(""); if (typeof(x = args[1]) == LIST) return {on, @x, off}; else return tostr(on, x, off); endif ">>>:TIME1.0: Compiled by ThwartedEfforts(#2) on Mon Jul 10 20:47:07 1995 MET DST"; . @verb $html_utils:"object_ref" this none this rx @program $html_utils:object_ref wo = $web_objects; request = args[1]; ind = request in wo.object_refs; if (ind) return wo.web_refs[ind]; else return tostr("/", tonum(request), "/"); endif ">>>:TIME1.0: Compiled by Kangor (#235) on Tue Jul 11 18:38:09 1995 MET DST"; . @verb $html_utils:"bold italic*s" this none this rx @program $html_utils:bold code = verb[1]; on = tostr("<", code, ">"); off = tostr(""); if (typeof(x = args[1]) == LIST) return {on, @x, off}; else return tostr(on, x, off); endif ">>>:TIME1.0: Compiled by ThwartedEfforts(#2) on Mon Jul 10 20:54:40 1995 MET DST"; . @verb $html_utils:"BR break" this none this rx @program $html_utils:BR return tostr("
"); ">>>:TIME1.0: Compiled by Kangor (#235) on Thu Jul 6 21:27:41 1995 MET DST"; . @verb $html_utils:"paragraph p" this none this rx @program $html_utils:paragraph return "

"; ">>>:TIME1.0: Compiled by Kangor (#235) on Mon Jul 17 18:56:37 1995 MET DST"; . @verb $html_utils:"table" this none this rx @program $html_utils:table border = args[2]; return {tostr(""), @(typeof(args[1]) == LIST) ? args[1] | {args[1]}, ""}; ">>>:TIME1.0: Compiled by ThwartedEfforts(#2) on Fri Jul 7 01:33:45 1995 MET DST"; . @verb $html_utils:"table_row" this none this rx @program $html_utils:table_row row_data = args[1]; heading = args[2] || ""; for elm in [1..length(row_data)] row_data[elm] = tostr("", row_data[elm]); endfor return {"", heading, @row_data, ""}; ">>>:TIME1.0: Compiled by ThwartedEfforts(#2) on Fri Jul 7 01:28:41 1995 MET DST"; . @verb $html_utils:"object_anchor" this none this rx @program $html_utils:object_anchor object = args[1]; label = args[2] || object.name; if (!$object_utils:has_verb(object, $httpd.request_method_name)) return label; endif value = tostr("/", tonum(object), "/"); ind = object in $web_objects.object_refs; if (ind) value = $web_objects.web_refs[ind]; endif if (is_player(object)) value = tostr("/~", object.name, "/"); endif return this:anchor(value, label); ">>>:TIME1.0: Compiled by ThwartedEfforts(#2) on Sun Aug 6 19:41:49 1995 MET DST"; . @verb $html_utils:"form_start" this none this rx @program $html_utils:form_start "hu:form_start(char method, url action); the method defaults to POST, the action is required"; if (length(args) < 2) return "

"; else method = args[1] ? tostr(args[1]) | "POST"; action = args[2]; if (typeof(action) == OBJ) action = this:object_ref(action); elseif (action) action = tostr(action); else action = "http://tecfasun1.unige.ch:4243/post-query"; endif if (0) action = args[2] ? tostr(args[2]) | "http://tecfasun1.unige.ch:4243/post-query"; endif return tostr(""); endif ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Fri Sep 29 07:17:12 1995 MET"; . @verb $html_utils:"form_end" this none this rx @program $html_utils:form_end return "
"; ">>>:TIME1.0: Compiled by Kangor (#235) on Fri Jul 7 19:10:53 1995 MET DST"; . @verb $html_utils:"form_text" this none this rx @program $html_utils:form_text "hu:form_text(char name, char value, int maxlength, char align, int size);"; "all values are required, but if they are false they will be ignored as attributes"; name = args[1] ? tostr(args[1], "\"") | "default\""; value = args[2] ? tostr(" VALUE=\"", args[2], "\"") | ""; maxlength = args[3] ? tostr(" MAXLENGTH=\"", args[3], "\"") | ""; align = args[4] ? tostr(" ALIGN=\"", args[4], "\"") | ""; size = args[5] ? tostr(" SIZE=\"", args[5], "\"") | ""; return tostr(""); ">>>:TIME1.0: Compiled by Kangor (#235) on Thu Jul 13 00:25:40 1995 MET DST"; . @verb $html_utils:"form_urldecode_value" this none this rx @program $html_utils:form_urldecode_value "$html_utils:form_urldecode_value(char name, char query_string);"; "Returns the value associated with name in the query_string."; "See \"help html\""; name = args[1]; query = args[2]; value = ""; if (x = index(query, name + "=")) x = (x + length(name)) + 1; value = query[x..length(query)]; value = value[1..(y = index(value, "&")) ? y - 1 | length(value)]; value = strsub(value, "+", " "); endif return value; ">>>:TIME1.0: Compiled by Kangor (#235) on Wed Sep 27 15:59:32 1995 MET"; . @verb $html_utils:"form_hidden" this none this rx @program $html_utils:form_hidden "hu:form_hidden(char name, char value);"; return tostr(""); ">>>:TIME1.0: Compiled by Kangor (#235) on Mon Jul 10 21:35:04 1995 MET DST"; . @verb $html_utils:"base" this none this rx @program $html_utils:base "$html_utils:base(char url);"; return tostr(""); ">>>:TIME1.0: Compiled by Kangor (#235) on Tue Jul 11 18:36:17 1995 MET DST"; . @verb $html_utils:"image" this none this rx @program $html_utils:image "$html_utils:image (char pic, char alt);"; "name is mandatory, alt is optional"; source = tostr("\"", $httpd.graphics_root, args[1] ? args[1] | "e_moo.gif", "\""); alt = args[2] ? tostr(" ALT=\"", args[2], "\"") | ""; border = tostr(" BORDER=0"); return tostr(""); ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Sat Sep 2 19:40:58 1995 MET DST"; . @verb $html_utils:"form_checkbox" this none this rx @program $html_utils:form_checkbox "hu:form_checkbox(char name, char value, char align, int size, int checked);"; "all values are required, but if they are false they will be ignored as attributes"; "one of these is required for each checkbox in a set of the same name"; name = args[1] ? tostr(args[1], "\"") | "default\""; value = args[2] ? tostr(" VALUE=\"", args[2], "\"") | ""; align = args[3] ? tostr(" ALIGN=\"", args[3], "\"") | ""; size = args[4] ? tostr(" SIZE=\"", args[4], "\"") | ""; checked = args[5] ? " CHECKED" | ""; return tostr(""); ">>>:TIME1.0: Compiled by Kangor (#235) on Thu Jul 13 00:34:26 1995 MET DST"; . @verb $html_utils:"form_image" this none this rx @program $html_utils:form_image "hu:form_image(char name, url source, char align, int size);"; "all values are required, but if they are false they will be ignored as attributes"; "an exception to the above is source which is required to have a value"; name = args[1] ? tostr(args[1], "\"") | "default\""; source = args[2] ? tostr(args[2], "\"") | "http://tecfasun1.unige.ch/~abakun/e_moo.gif\""; align = args[3] ? tostr(" ALIGN=\"", args[3], "\"") | ""; size = args[4] ? tostr(" SIZE=\"", args[4], "\"") | ""; return tostr(""); ">>>:TIME1.0: Compiled by Kangor (#235) on Thu Aug 17 21:23:49 1995 MET DST"; . @verb $html_utils:"form_radio" this none this rx @program $html_utils:form_radio "hu:form_radio(STR label, STR group name, STR value, STR align, NUM size, NUM checked);"; "all values are required, but if they are false they will be ignored as attributes"; "one of these is required for each radio button in a set of the same name"; "only one radio button in a set of the same set can be checked"; "label is the label that will appear to the right of the button (tef)"; name = args[2] ? tostr(args[1], "\"") | "default\""; value = args[3] ? tostr(" VALUE=\"", args[2], "\"") | ""; align = args[4] ? tostr(" ALIGN=\"", args[3], "\"") | ""; size = args[5] ? tostr(" SIZE=\"", args[4], "\"") | ""; checked = args[6] ? " CHECKED" | ""; return tostr(" ", args[1]); ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Mon Oct 9 20:18:41 1995 MET"; . @verb $html_utils:"form_reset" this none this rx @program $html_utils:form_reset "$hu:form_reset(char value); "; "value is an optional argument that will be the button label."; return tostr(" 0) ? args[1] ? tostr(" VALUE=\"", args[1], "\"") | "" | "", ">"); ">>>:TIME1.0: Compiled by Kangor (#235) on Wed Jul 12 23:59:15 1995 MET DST"; . @verb $html_utils:"form_submit" this none this rx @program $html_utils:form_submit "$hu:form_submit(char name, char value); "; "Both values are optional, the name identifies the particular button to the script, and the value is the button label."; return tostr(" 0) ? args[1] ? tostr(" NAME=\"", args[1], "\"") | "" | "", (length(args) > 1) ? args[2] ? tostr(" VALUE=\"", args[2], "\"") | "" | "", ">"); ">>>:TIME1.0: Compiled by Kangor (#235) on Wed Jul 12 23:45:42 1995 MET DST"; . @verb $html_utils:"form_select_start" this none this rx @program $html_utils:form_select_start "hu:form_select_start(char name, int size, int multiple);"; "Values are required for all arguments, however a true value is require only for name."; "The size and multiple args are ignored when filled with a false value."; name = args[1] ? tostr(args[1], "\"") | "default\""; size = args[2] ? tostr(" SIZE=\"", args[2], "\"") | ""; multiple = args[3] ? " MULTIPLE" | ""; return tostr(""; ">>>:TIME1.0: Compiled by Kangor (#235) on Tue Aug 15 21:10:48 1995 MET DST"; . @verb $html_utils:"form_textarea" this none this rx @program $html_utils:form_textarea "hu:form_textarea (char name, int rows, int cols, char text)"; "name, rows, and cols are required arguments; text is optional"; name = tostr(" NAME=\"", args[1], "\""); rows = tostr(" ROWS=\"", args[2], "\""); cols = tostr(" COLS=\"", args[3], "\""); text = args[4] ? args[4] | ""; return {tostr(""), text, ""}; . @verb $html_utils:"verb_code" this none this rx @program $html_utils:verb_code ":verb_code ( OBJ, VERB [, {lower, upper} ] )"; range = args[3]; methodref = args[1..2]; set_task_perms(caller_perms()); code = verb_code(@methodref, 1, 1); if (typeof(code) == ERR) return code; endif if (range) rstr = tostr("Lines ", range[1], " through ", range[2], "."); pre = (range[1] == 1) ? {} | {"..."}; post = (range[2] == length(code)) ? {} | {"..."}; code = {@pre, @code[range[1]..range[2]], @post}; endif code = this:pre(code); assignments = {}; sys = $sys; for x in [1..length(code)] line = code[x]; if (index(line, " = $")) y = match(line, "%([a-za-Z_]+%) = %$%([a-za-Z_]+%)"); object = substitute("%2", y); if (valid(sys.(object))) assignments = {@assignments, {substitute("%1", y), tostr("$", object)}}; endif endif code[x] = this:code_to_html(code[x], methodref[1], methodref[2], assignments); endfor code = {@rstr ? {this:heading3(rstr)} | {}, @code}; return code; ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Wed Nov 1 00:43:59 1995 MET"; . @verb $html_utils:"form_urldecode_all" this none this rx @program $html_utils:form_urldecode_all "$html_utils:form_urldecode_all(char query_string);"; "Returns all name/value pairs in the given query_string."; "See \"help html\""; su = $string_utils; query = strsub(args[1], "?", ""); query = su:explode(query, "&"); for x in [1..length(query)] query[x] = su:explode(query[x], "="); if (length(query[x]) > 1) query[x][2] = strsub(query[x][2], "+", " "); endif endfor return query; ">>>:TIME1.0: Compiled by Kangor (#235) on Wed Sep 27 16:20:05 1995 MET"; . @verb $html_utils:"pre" this none this rx @program $html_utils:pre text = $list_utils:flatten(args); columns = args[2] || 100; su = $string_utils; x = 0; command_utils = $command_utils; for line in [1..length(text)] x = x + 1; text[line] = this:special_chars_sub(text[line]); text[line] = this:_linesplit(text[line], columns); (!(x % 3)) && command_utils:suspend_if_needed(0); endfor return {"
", @$list_utils:flatten(text), "
"}; ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Fri Sep 29 18:16:46 1995 MET"; . @verb $html_utils:"_linesplit" this none this rx @program $html_utils:_linesplit ":_linesplit(line,len) => list of substrings of line"; "used by :pre to split up long lines if len>0"; line = args[1]; len = args[2]; spaces = match(line, "^%( *%).*"); if (spaces) spaces = spaces[3][1]; ident = line[spaces[1]..spaces[2]]; else ident = " "; endif su = $string_utils; cline = {}; while (length(line) > len) cutoff = rindex(line[1..len], " "); if (nospace = cutoff < (len / 3)) cutoff = len + 1; nospace = line[cutoff] != " "; endif cline = {@cline, line[1..cutoff - 1]}; line = (nospace ? "" | ident) + line[cutoff..length(line)]; endwhile return {@cline, line}; ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Thu Aug 31 00:04:22 1995 MET DST"; . @verb $html_utils:"special_chars_sub" this none this rx @program $html_utils:special_chars_sub return $string_utils:substitute(args[1], this.html_subs); ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Tue Sep 5 10:03:02 1995 MET DST"; . @verb $html_utils:"html_title_list html_title_listc" this none this @program $html_utils:html_title_list "wr_utils:title_list/title_listc([, @)"; "Creates an english list out of the titles of the objects in . Optional are passed on to $string_utils:english_list."; "title_listc uses :titlec() for the first item."; hu = $html_utils; titles = {}; for x in (args[1]) titles = {@titles, hu:object_anchor(x, x:title())}; endfor if (verb[length(verb)] == "c") if (titles) titles[1] = hu:object_anchor(args[1][1], args[1][1]:titlec()); elseif (length(args) > 1) args[2] = $string_utils:capitalize(args[2]); else args = listappend(args, "Nothing"); endif endif return $string_utils:english_list(titles, @args[2..length(args)]); ">>>Copied from string utilities (#20):html_title_list written by Hacker (#38) Fri Jul 28 00:05:04 1995 MET DST"; ">>>:TIME1.0: Compiled by Kangor (#235) on Fri Jul 28 00:05:04 1995 MET DST"; . @verb $html_utils:"mailto" this none this rx @program $html_utils:mailto address = this:special_chars_sub(args[1]); return tostr(this:anchor(tostr("mailto:", address), args[2] || address)); ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Fri Sep 22 03:59:46 1995 MET DST"; . @verb $html_utils:"format format_moo" this none this rx @program $html_utils:format "$html_utisl:format( LIST text )"; ""; "Returns text with lines ending with
, so as to preserve line breaks, but keep from using mono-spacced text"; text = args[1]; format_for_moo = verb == "format_moo"; if ((length(args) == 1) && (typeof(text) == STR)) return tostr(text, "
"); endif text = $list_utils:flatten(args); for x in [1..length(text)] text[x] = tostr(this:special_chars_sub(text[x]), "
"); if (format_for_moo) while (y = match(text[x], " %(%$[a-zA-Z_]+%(:%|%.%)[a-zA-Z1-90_]+%)")) y = y[3][1]; text[x][y[1]..y[2]] = this:tt(text[x][y[1]..y[2]]); endwhile while (y = match(text[x], " %(%(:%|%.%)[a-zA-Z_]+%)")) y = y[3][1]; text[x][y[1]..y[2]] = this:tt(text[x][y[1]..y[2]]); endwhile endif endfor return text; ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Tue Sep 5 21:52:31 1995 MET DST"; . @verb $html_utils:"unordered_list" this none this rx @program $html_utils:unordered_list ulist = args[1]; lines = {}; for x in (ulist) lines = {@lines, tostr("
  • ", x)}; endfor return {"
      ", @lines, "
    "}; ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Wed Aug 16 23:20:51 1995 MET DST"; . @verb $html_utils:"ordered_list" this none this rx @program $html_utils:ordered_list on = "
      "; off = "
    "; args = args[1]; for x in [1..length(args)] args[x] = tostr("
  • ", args[x]); endfor return {on, @args, off}; ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Sun Aug 27 09:59:19 1995 MET DST"; . @verb $html_utils:"code_to_html" this none this rx @program $html_utils:code_to_html ":code_to_html ( STR, OBJ )"; "STR should be a line of code, OBJ should be the value of 'this'"; line = args[1]; object = args[2]; methodname = args[3]; assignments = args[4]; lhs = $list_utils:slice(assignments, 1); rhs = $list_utils:slice(assignments, 2); passregexp = "%(^%|%.%.%|[[{@!( ]%)%(pass%)("; passlink = "/code/"; bfregexp = "%(^%|%.%.%|[[{@!( ]%)%([a-zA-Z_]+%)("; bflink = "/help/"; methodregexp = "%(^%|%.%.%|[[{@!( ]%)%(%$?[a-zA-Z_0-9]+:[a-zA-Z_0-9]+%)("; methodlink = "/code/"; thisregexp = "%(^%|%.%.%|[[{@!( ]%)%(this:[a-zA-Z_0-9]+%)("; thislink = "/code/"; playerregexp = "%(^%|%.%.%|[[{@!( ]%)%(%(who%|player%):[a-zA-Z_0-9]+%)("; playerlink = "/code/"; replacements = {}; colorchange = "+++"; while (x = match(line, passregexp)) sub = x[3][2]; string = line[sub[1]..sub[2]]; defparent = $object_utils:has_verb(parent(object), methodname); if (defparent) defparent = defparent[1]; link = {tostr(crypt(tostr(defparent)), "*"), strsub(tostr($wiz_utils:core_ref(defparent), ":", methodname), "#", "")}; anchor = {tostr(crypt(tostr(defparent)), "*"), string}; line[sub[1]..sub[2]] = this:anchor(tostr(passlink, link[1]), anchor[1]); replacements = {@replacements, link, anchor}; endif endwhile while (x = match(line, bfregexp)) sub = x[3][2]; string = line[sub[1]..sub[2]]; string = {tostr(crypt(string), "*"), string}; line[sub[1]..sub[2]] = this:anchor(tostr(bflink, string[1], "()"), string[1]); replacements = {@replacements, string}; (((seconds_left() < 2) || ticks_left()) < 400) && suspend(0); endwhile while (x = match(line, thisregexp)) sub = x[3][2]; string1 = line[sub[1]..sub[2]]; link = string1; o = $object_utils:has_verb(object, link[index(link, ":") + 1..length(link)]); if (o) o = o[1]; link[1..index(link, ":") - 1] = strsub(tostr($wiz_utils:core_ref(o)), "#", ""); link = {tostr(crypt(string1), "*"), link}; anchor = {tostr(crypt(string1), "*"), string1}; line[sub[1]..sub[2]] = this:anchor(tostr(thislink, link[1]), anchor[1]); replacements = {@replacements, link, anchor}; else org = line[sub[1]..sub[2]]; new = tostr(crypt(org), "*"); line[sub[1]..sub[2]] = new; replacements = {@replacements, {new, strsub(colorchange, "+++", org)}}; endif (((seconds_left() < 2) || ticks_left()) < 400) && suspend(0); endwhile while (x = match(line, playerregexp)) sub = x[3][2]; string1 = line[sub[1]..sub[2]]; link = string1; object = $object_utils:has_verb($wiz, $string_utils:explode(string1, ":")[2]); if (object) link[1..index(link, ":") - 1] = tostr($wiz_utils:core_ref(object[1])); link = {tostr(crypt(string1), "*"), link}; anchor = {tostr(crypt(string1), "*"), string1}; line[sub[1]..sub[2]] = this:anchor(tostr(playerlink, link[1]), anchor[1]); replacements = {@replacements, link, anchor}; else org = line[sub[1]..sub[2]]; new = tostr(crypt(org), "*"); line[sub[1]..sub[2]] = new; replacements = {@replacements, {new, strsub(colorchange, "+++", org)}}; endif (((seconds_left() < 2) || ticks_left()) < 400) && suspend(0); endwhile while (x = match(line, methodregexp)) sub = x[3][2]; string = line[sub[1]..sub[2]]; link = string; "convert assigned core refs to their real counterparts"; colon = index(link, ":") - 1; x = link[1..colon]; if (xInRHS = x in lhs) link[1..colon] = rhs[xInRHS]; replacements = {@replacements, {tostr(crypt(link), "*"), link}}; endif string = {tostr(crypt(string), "*"), string}; line[sub[1]..sub[2]] = this:anchor(tostr(methodlink, link), string[1]); replacements = {@replacements, string}; (((seconds_left() < 2) || ticks_left()) < 400) && suspend(0); endwhile line = $string_utils:substitute(line, replacements); return line; ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Wed Nov 1 00:47:52 1995 MET"; . @verb $html_utils:"def_list" this none this rx @program $html_utils:def_list lines = {}; for x in (args[1]) lines = {@lines, tostr("
    ", x[1]), "
    ", x[2]}; endfor return {"
    ", @lines, "
    "}; ">>>:TIME1.0: Compiled by ThwartedEfforts (#2) on Mon Sep 18 22:56:59 1995 MET DST"; . @verb $html_utils:"menu" this none this rx @program $html_utils:menu on = ""; off = ""; args = args[1]; for x in [1..length(args)] args[x] = tostr("
  • ", args[x]); endfor return {on, @args, off}; ">>>:TIME1.0: Compiled by Kangor (#235) on Mon Oct 9 16:18:39 1995 MET"; . @verb $html_utils:"anchor_name" this none this rx @program $html_utils:anchor_name ":anchor( label, content )"; label = args[1]; content = args[2] || label; return tostr("", content, ""); ">>>Copied from HTML Utilities ($html_utils):anchor written by ThwartedEfforts (#2) Tue Oct 10 02:53:45 1995 MET"; ">>>:TIME1.0: Compiled by Kangor (#235) on Tue Oct 10 02:56:18 1995 MET"; . @rmverb $list_utils:flatten @verb $list_utils:"flatten*_suspended" this none this rxd @program $list_utils:flatten ":flatten*_suspended(LIST list_of_lists) => LIST of all lists in given list `flattened'"; newlist = {}; suspendable = verb == "flatten_suspended"; for elm in (args) if (typeof(elm) == LIST) newlist = {@newlist, @this:(verb)(@elm)}; else newlist = {@newlist, elm}; endif if (suspendable && (ticks_left() < 400 || seconds_left() < 2)) suspend(0); endif endfor return newlist; . @verb $wiz_utils:"core_ref" this none this rxd @program $wiz_utils:core_ref "this isn't E_MOO's verb probably, but it does the job (at least on recent LambdaCore MOOs)"; return $code_utils:corify_object(args[1]); . @verb $string_utils:"matchable_string" this none this rxd @program $string_utils:matchable_string "$string_utils:matchable_string(OBJ) => STR"; ""; "Returns a string that will match the given object"; what = args[1]; if (is_player(what)) return tostr("~", what.name); elseif ($object_utils:isa(what, $mail_recipient)) if (what.location == $mail_agent) return tostr("*", what.aliases[1]); else return tostr(what); endif else return tostr($wiz_utils:core_ref(what)); endif . @verb $code_utils:"format_traceback" this none this rxd Hacker @program $code_utils:format_traceback "Usage: :format_traceback(exception)"; ""; "format a traceback like the server does, given output from "; "the exception handling traceback value or callers(line numbers)"; {error, msg, value, tb} = args; {top, @tb} = tb; msg = tostr(": ", msg); oldplayer = player; text = {this:_format_traceback_frame(top, oldplayer) + msg}; oldplayer = top[5]; for fr in (tb) text = {@text, "... called from " + this:_format_traceback_frame(fr, oldplayer)}; oldplayer = fr[5]; endfor text = {@text, "(End of traceback)"}; return text; "Based on a verb from JaysHouseMOO"; . @verb $code_utils:"_format_traceback_frame" this none this rxd Hacker @program $code_utils:_format_traceback_frame "Usage: :_format_traceback_frame(frame)"; ""; {frame, ?oldplayer = player} = args; {ths, vname, prog, vloc, plyr, ?line = 0} = frame; if (vloc == #-1 && prog == #-1 && vname != "") vname = "built-in function " + vname + "()"; elseif (vloc == #-1 && vname == "") vname = "Input to eval()"; elseif (vloc < #0 || prog < #0) "how does this HAPPEN?"; vname = "vloc and prog are both < #0 -- what?"; else vname = tostr($string_utils:matchable_string(vloc), ":", vname); endif if (vloc != ths) thstr = tostr(" (this == ", $string_utils:matchable_string(ths), ")"); else thstr = ""; endif if (oldplayer != plyr) plyrstr = tostr(" (player == ", plyr, ")"); else plyrstr = ""; endif return tostr(vname, thstr, ", line ", line || "?", plyrstr); "Based on a verb from JaysHouseMOO"; . @create $thing named Webbable Objects,web_objects @prop #0."web_objects" #-1 rc ;;$web_objects = player:my_match_object("web_objects"); @prop $web_objects."default" #-1 rc ;;$web_objects.("default") = $httpd; ;"***Finished***"