@prop $kahuna."port" 2222 rc @prop $kahuna."operator" #2 rc @prop $kahuna."logging" 1 rc @prop $kahuna."directlogging" 0 c @prop $kahuna."standardlogging" 1 c @prop $kahuna."fuplogging" 0 c @prop $kahuna."modules" {} rc ;;$kahuna.("modules") = {{"Aloha", $kahuna}} @prop $kahuna."name2objnb" {} rc @prop $kahuna."server_software" "Aloha Web Server - Version 2.2" rc @prop $kahuna."html_path" "" rc @prop $kahuna."default_index" "index.html" rc @prop $kahuna."outgoing_packets" 0 rc @prop $kahuna."ticks_threshold" 100 rc @prop $kahuna."help_msg" {} rc ;;$kahuna.("help_msg") = {"Moo Web Server", "The documentation and sources can be found at:", "http://moo.kcc.hawaii.edu/aloha"} @prop $kahuna."error_types" {} rc ;;$kahuna.("error_types") = {{"400", "Bad Request&Several reasons might cause this error: bad or missing referer."}, {"403", "Forbidden&Access is forbidden to the requested page. Most likely due to a security violation in the headers."}, {"404", "Page Not Found&Please check the URL that you are trying to access."}, {"500", "Internal Server Error&The request was not completed. The server met an unexpected condition."}} @prop $kahuna."version" "1073900832" rc ;;$kahuna.("aliases") = {"kahuna"} @verb $kahuna:"do_login_command" this none this @program #96:do_login_command "-- the guy who gets the first hit --"; if (valid(player)) return; endif input = {}; set_connection_option(player, "hold-input", 1); "-- Gets the Method, URL, and HTTPD version --"; request = argstr; request = read(player); input = {@input, request}; if (index(request, "GET") == 1 || index(request, "POST") == 1) while (data = read(player)) input = {@input, data}; endwhile "-- GET Method --"; if (index(request, "GET") == 1) this:parse_get(input); if (this.logging) this:export_log(input); endif endif "-- POST Method --"; for i in [1..length(input)] if (index(input[i], "Content-type: ") == 1) ctype = $string_utils:explode(input[i], " "); boundary = ""; if (length(ctype) > 1 && ctype[2] == "multipart/form-data;") "-- Gets the Boundary (multipart/form-data) --"; boundary = "--" + $string_utils:explode(input[i], "=")[2] + "--"; while (1) try data = read(player); input = {@input, data}; "-- Compares the Boundary value with the incoming Data --"; "-- & Cuts off the connection when they match --"; if (boundary == input[length(input)]) this:parse_post(input); break; endif except (ANY) this:parse_post(input); break; endtry endwhile if (this.logging) this:export_log(input); endif i = length(input); endif else if (index(input[i], "Content-length: ") == 1) clen = toint($string_utils:explode(input[i], " ")[2]); rlen = 0; for j in [i + 1..length(input)] rlen = rlen + length(input[j]); endfor while (rlen < clen) data = read(player); rlen = rlen + length(data); input = {@input, data}; endwhile this:parse_post_nf(input); i = length(input); endif endif endfor boot_player(player); else "If not GET or POST, just return NOT FOUND."; "Someday, we can add other methods"; $kahuna:ok({"Not known method"}); endif . @verb $kahuna:"is_listening" this none this @program $kahuna:is_listening "-- This is not meant to be called directly. --"; "-- Used by $kahuna:start() and $kahuna:stop() to check --"; "-- if the port is open -> ;listeners() --"; if (caller != $kahuna) return E_PERM; else if (this in $list_utils:slice(listeners(), 1)) return 1; endif endif . @verb $kahuna:"@start" this none none @chmod $kahuna:"@start" rxd @program $kahuna:@start "-- This is the proper way to start the Aloha Web Server. --"; "-- @start $kahuna usually does the job... --"; if (!player.wizard) return E_PERM; elseif (this:is_listening()) notify(player, " "); notify(player, ((toobj(this).name + " (") + tostr(this)) + ") is already running"); notify(player, "and listening on port: " + tostr(this.port)); notify(player, "---------------------------"); notify(player, " "); else listen(this, this.port); notify(player, " "); notify(player, ((toobj(this).name + " (") + tostr(this)) + ") started."); notify(player, "...listening on port: " + tostr(this.port)); notify(player, "---------------------------"); notify(player, " "); "-- checking for updates --"; notify(player, "Do you want to check for updates? (y/n)"); answer = read(player); if ((((answer == "y") || (answer == "Y")) || (answer == "yes")) || (answer == "YES")) notify(player, "OK, checking for updates now..."); this:update(); elseif ((((answer == "n") || (answer == "N")) || (answer == "no")) || (answer == "NO")) notify(player, "OK, you will have to check them yourself manually."); else notify(player, "I dunno what to tell you Dude...."); endif "-- registering --"; fork (0) this:register(); endfork endif . @verb $kahuna:"@stop" this none none @chmod $kahuna:"@stop" rxd @program $kahuna:@stop "-- This is the proper way to stop the Aloha Web Server. --"; "-- @stop $kahuna usually does the job... --"; if (!player.wizard) return E_PERM; elseif (!this:is_listening()) notify(player, " "); notify(player, ((toobj(this).name + " (") + tostr(this)) + ") is not running"); notify(player, "and not listening on any port. "); notify(player, "---------------------------"); notify(player, " "); else unlisten(this.port); notify(player, " "); notify(player, ((toobj(this).name + " (") + tostr(this)) + ") is stopped."); notify(player, "... no longer listening on port " + tostr(this.port)); notify(player, "---------------------------"); notify(player, " "); endif . @verb $kahuna:"export_log" this none this @program $kahuna:export_log "-- called by $kahuna:do_login_command() --"; "-- and checks whether or not the Log object has been installed --"; "-- if so, it showel the task to it --"; if (caller != $kahuna) return E_PERM; else input = args[1]; if ("Aloha_log" in $list_utils:slice(this.modules, 1)) "-- The object has been installed, let's fetch it --"; Aloha_log = $hash_utils:fetch(this.modules, "Aloha_Log"); fork (0) toobj(Aloha_log):gateway_log(input); "-- update properties for the Statistics Page --"; method = $string_utils:explode(input[1], " ")[1]; if (method == "GET") Aloha_log.incoming_get_packets = Aloha_log.incoming_get_packets + 1; elseif (method == "POST") Aloha_log.incoming_post_packets = Aloha_log.incoming_post_packets + 1; endif endfork return; endif return; endif . @verb $kahuna:"parse_get" this none this @program $kahuna:parse_get "-- called by $kahuna:do_login_command --"; "-- handles all GET method requests --"; if (caller != $kahuna) return E_PERM; else input = args[1]; env = this:get_env(input); object = ""; verb = ""; data = ""; query = $string_utils:explode(input[1], " ")[2]; "-- Case of http://server:port or http://server:port/ --"; if (query == "/") this:proxyindex(env); return; endif "-- Case of http://server:port/obj or http://server:port/obj/ --"; sueq = $string_utils:explode(query, "/"); if (length(sueq) == 1) "-- let's investigate the eventuality of obj?var --"; if (index(sueq[1], "?")) "-- something is there... --"; object = $string_utils:explode(sueq[1], "?")[1]; data = $string_utils:explode(sueq[1], "?")[2]; else object = sueq[1]; endif if (!$string_utils:is_numeric(object)) "-- it's nice to have names in the URL rather than number sometimes --"; "-- let's handle player names first --"; if ((x = $string_utils:match_player(object)) != $failed_match) object = x; else "-- this name would correspond to a valid object in our db? --"; if (obidx = object in $list_Utils:slice(this.name2objnb)) object = this.name2objnb[obidx][2]; "-- I guess not --"; else this:error("404", object, env); return; endif endif endif "-- Checks for an existing Object in the Database --"; OBJ = toobj(tonum(object)); "-- this is indeed a nb but does it refer to an existing obj_nb? --"; if (!valid(OBJ)) this:error("404", OBJ, env); return; endif if (data) hash = $hash_utils:parse_query(data); OBJ:Aloha_default(OBJ, hash, env); else OBJ:Aloha_default(OBJ, env); endif return; endif "-- Case of http://server:port/obj/verb or http://server:port/obj/verb/ --"; if (length(sueq) == 2) object = sueq[1]; "-- Is there any arguments passed in there? --"; if (index(sueq[2], "?")) "-- arguments are being passed along --"; if (length($string_utils:explode(sueq[2], "?")) > 1) verb = $string_utils:explode($string_utils:explode(sueq[2], "?")[1], ".")[1]; data = $string_utils:explode(sueq[2], "?")[2]; else "-- this is a malformed URL: obj/?var --"; this:error("404", object, env); return; endif else "-- no arguments passed --"; verb = $string_utils:explode(sueq[2], ".")[1]; endif "-- let's not forget to check the validity of the object --"; if (!$string_utils:is_numeric(object)) "-- let's handle player names first --"; if ((x = $string_utils:match_player(object)) != $failed_match) object = x; else "-- this name would correspond to a valid object in our db? --"; if (obidx = object in $list_Utils:slice(this.name2objnb)) object = this.name2objnb[obidx][2]; else "-- I guess not... (what a comedian) --"; this:error("404", object, env); return; endif endif endif OBJ = toobj(tonum(object)); "-- Checks for an existing Object in the Database --"; if (!valid(OBJ)) this:error("404", object, env); return; endif "-- Checks if the obj_nb has indeed the called verb --"; if (!$object_utils:has_callable_verb(OBJ, verb)) this:error("404", object, env); return; endif endif object = toobj(tonum(object)); hash = {}; if (data) hash = $hash_utils:parse_query(data); endif object:(verb)(hash, env); endif . @verb $kahuna:"get_env" this none this "-- called by $kahuna:parse_get() --"; "-- return all environmental variables --"; "-- if you'd lke to define some more, feel free --"; if (caller != $kahuna) return E_PERM; else lines = args[1]; hash = {}; hash = $hash_utils:put(hash, "SERVER_SOFTWARE", this.server_software); hash = $hash_utils:put(hash, "GATEWAY_INTERFACE", "CGI/1.1"); hash = $hash_utils:put(hash, "SERVER_PROTOCOLE", $string_utils:explode(lines[1], " ")[3]); hash = $hash_utils:put(hash, "REQUEST_METHOD", $string_utils:explode(lines[1], " ")[1]); if (index($string_utils:explode(lines[1], " ")[2], "?") != 0) hash = $hash_utils:put(hash, "QUERY_STRING", $string_utils:explode($string_utils:explode(lines[1], " ")[2], "?")[2]); endif len = length(lines); for i in [1..len] if (length($string_utils:explode($string_utils:explode(lines[1], " ")[2], "/")) > 1) hash = $hash_utils:put(hash, "SCRIPT_NAME", $string_utils:explode($string_utils:explode($string_utils:explode(lines[1], " ")[2], "/")[2], "?")[1]); endif target = "Host: "; if (index(lines[i], target) == 1) hash = $hash_utils:put(hash, "SERVER_NAME", $string_utils:explode(lines[i][length(target) + 1..length(lines[i])], ":")[1]); hash = $hash_utils:put(hash, "SERVER_PORT", $string_utils:explode(lines[i][length(target) + 1..length(lines[i])], ":")[2]); endif target = "Content-type: "; if (index(lines[i], target) == 1) hash = $hash_utils:put(hash, "CONTENT-TYPE", lines[i][length(target) + 1..length(lines[i])]); endif target = "Content-length: "; if (index(lines[i], target) == 1) hash = $hash_utils:put(hash, "CONTENT-LENGTH", lines[i][length(target) + 1..length(lines[i])]); endif target = "User-Agent: "; if (index(lines[i], target) == 1) hash = $hash_utils:put(hash, "HTTP_USER_AGENT", lines[i][length(target) + 1..length(lines[i])]); endif target = "Referer: "; if (index(lines[i], target) == 1) hash = $hash_utils:put(hash, "HTTP_REFERER", lines[i][length(target) + 1..length(lines[i])]); endif target = "Accept-Language: "; if (index(lines[i], target) == 1) hash = $hash_utils:put(hash, "HTTP_LANGUAGE", lines[i][length(target) + 1..length(lines[i])]); endif target = "Accept-Charset: "; if (index(lines[i], target) == 1) hash = $hash_utils:put(hash, "HTTP_CHARSET", lines[i][length(target) + 1..length(lines[i])]); endif target = "Accept-Encoding: "; if (index(lines[i], target) == 1) hash = $hash_utils:put(hash, "HTTP_ACCEPT", lines[i][length(target) + 1..length(lines[i])]); endif endfor return hash; endif . @verb $kahuna:"ok" this none this @program $kahuna:ok if (length(args) < 1) this:error("500", this, args[2]); return; endif "-- Records the number of hits --"; this.outgoing_packets = this.outgoing_packets + 1; doc = args[1]; cache = 1; notify(player, "HTTP/1.1 200 OK"); notify(player, "Server: " + this.server_software); notify(player, "MIME-version: 1.0"); notify(player, "Connection: close"); notify(player, "Pragma: no-cache"); notify(player, "Content-type: text/html"); content_len = this:get_content_length(doc); notify(player, "Content-length: " + tostr(content_len)); notify(player, ""); len = length(doc); for x in [1..len] (ticks_left() < $kahuna.ticks_threshold) && suspend(0); notify(player, doc[x]); endfor if (buffered_output_length(player)) while (buffered_output_length(player)) suspend(0); endwhile endif boot_player(player); . @verb $kahuna:"create_headers" this none this @program $kahuna:create_headers "-- called by any verb that wants to have these headers --"; env = args[1]; page = {}; page = {@page, $string_utils:from_list({" "})}; page = {@page, " "}; return page; . @verb $kahuna:"proxyindex" this none this @program $kahuna:proxyindex "-- redirects the default page --"; "-- will read $kahuna.default_index if $kahuna.html_path != \"\" --"; if (caller != $kahuna) return E_PERM; else if ($kahuna.html_path == "") "-- generates the index page from here --"; env = args[1]; page = {}; page = {@page, ""}; page = {@page, " "}; page = {@page, @this:create_headers(env)}; page = {@page, " "}; page = {@page, ""}; page = {@page, "
Aloha Web Server Index Page.
"}; page = {@page, "

"}; page = {@page, "Make sure you create your own default page. See the documentation for this."}; page = {@page, "Aloha."}; page = {@page, ""}; page = {@page, ""}; page = {@page, ""}; page = {@page, ""}; $kahuna:ok(page); else env = args[1]; page = {}; page = {@page, ""}; page = {@page, " "}; page = {@page, @this:create_headers(env)}; page = {@page, $string_utils:from_list({""})}; page = {@page, " "}; page = {@page, ""}; $kahuna:ok(page); endif endif . @verb $kahuna:"get_content_length" this none this @program $kahuna:get_content_length "-- called by $kahuna:ok() --"; "-- used to figure the content_length --"; "-- of a page to be displayed --"; if (caller != $kahuna) return E_PERM; else if (length(args) != 1) return E_ARGS; endif if (typeof(args[1]) != LIST) return E_TYPE; endif "-- Count newlines in content length (2002-Jan-14 dilger@nwe.ufl.edu) --"; "-- Assuming DOS linefeed/newline (^M) --"; clen = len = length(args[1]); clen = 2 * len; for i in [1..len] clen = clen + length(args[1][i]); endfor return clen; endif . @verb $kahuna:"error" this none this "-- called by anything that complains --"; if (caller != $kahuna) return E_PERM; else {error_type, object, env} = args; types = this.error_types; page = {}; page = {@page, ""}; page = {@page, " "}; page = {@page, @this:create_headers(env)}; page = {@page, " "}; page = {@page, ""}; page = {@page, ""}; page = {@page, " "}; if ($kahuna.html_path != "") page = {@page, $string_utils:from_list({" "}; page = {@page, " "}; page = {@page, " "}; page = {@page, " "}; page = {@page, " "}; page = {@page, " "}; page = {@page, " "}; page = {@page, " "}; page = {@page, " "}; page = {@page, " "}; page = {@page, " "}; page = {@page, "
"})}; else page = {@page, $string_utils:from_list({" "})}; endif page = {@page, "
    "}; page = {@page, "
      "}; if ($kahuna.html_path != "") page = {@page, $string_utils:from_list({"
      "})}; else page = {@page, "

      Aloha Web Server

      "}; endif page = {@page, "   Give Aloha from your MOO.

      "}; page = {@page, "
    "}; page = {@page, "
"}; page = {@page, "
"}; page = {@page, "
    "}; page = {@page, "
      "}; page = {@page, $string_utils:from_list({" The Server has reported the following error:

      Error ", error_type, "

      "})}; page = {@page, "
    "}; page = {@page, "
"}; page = {@page, $string_utils:from_list({"

", $string_utils:explode($hash_utils:fetch(types, error_type), "&")[1], "

"})}; page = {@page, "The requested document could not be found on this server.
"}; page = {@page, $string_utils:explode($hash_utils:fetch(types, error_type), "&")[2]}; page = {@page, $string_utils:from_list({"
If you are sure that it is correct, contact the MOO System administrator of this site.

"})}; page = {@page, "
"}; page = {@page, "

Copyright © 2001-2003 Aloha Web Server

"}; page = {@page, ""}; page = {@page, ""}; $kahuna:ok(page); "-- Let's create a record of all errors sorted by type if logging is enabled--"; if (this.logging) if ("Aloha_log" in $list_utils:slice(this.modules, 1)) "-- The object has been installed, let's fetch it --"; Aloha_log = $hash_utils:fetch(this.modules, "Aloha_Log"); fork (0) toobj(Aloha_log):save_error_log(error_type, object); endfork endif endif endif . @verb $kahuna:"parse_post" this none this @program $kahuna:parse_post "-- called by $kahuna:do_login_command --"; "-- handles all POST method requests --"; if (caller != $kahuna) return E_PERM; else input = args[1]; hash = hash_url = hash_post = hash_url_referer = {}; "-- well here is the deal... --"; "-- some could pass variable using BOTH GET and POST --"; "-- that is through FORMS and on the URL ?var=blabl&var=bloblo --"; "-- so really, we should extract any variable in the URL IF --"; "-- there is any - so let's look first for residue and if --"; "-- if find any, we'll call a cousin of parse_get to handle it --"; {object, verb, data, referer_data} = this:parse_url(args[1]); object = toobj(tonum(object)); if (index(data, "=")) hash_url = $hash_utils:parse_query(data); endif if (referer_data) hash_url_referer = $hash_utils:parse_query(referer_data); endif "-- gets the hash from the FORM fields --"; hash_post = this:parse_form_field(args[1]); hash = {@hash, hash_url, hash_post, hash_url_referer}; env = this:get_env(input); object:(verb)(hash, env); endif . @verb $kahuna:"parse_url" this none this @program $kahuna:parse_url "-- called by $kahuna:parse_post --"; "-- extracts the object number, the verb and the data --"; "-- as there could be a GET method as well passed through --"; "-- that is data passed through the URL. --"; "-- and we'll grab residues GET data from the referer --"; "-- in case it's needed (security?)--"; if (caller != $kahuna) return E_PERM; else input = args[1]; object = verb = data = error = referer_data = ""; query = $string_utils:explode(input[1], " ")[2]; object = $string_utils:explode(query, "/")[1]; verb = $string_utils:explode($string_utils:explode(query, "/")[2], "?")[1]; env = this:get_env(input); target = $hash_utils:match_anystr_in_list(input, "Referer:"); if (target != 0) "-- let's first check that the request is not spoofed --"; if (error = this:check_spoofed_referer(input[target[2]]) == 1) "-- Takes the data out of the Referer if it exits --"; if (length($string_utils:explode(input[target[2]], "?")) == 1) referer_data = ""; else referer_data = $string_utils:explode(input[target[2]], "?")[2]; endif else this:error(error, object, env); endif else "-- There is no Referer in the bugger --"; "-- is that possible for a POST request btw? --"; this:error("400", object, env); endif "-- now we need to check the validity of the POST request --"; "-- coming in. Very similar to check_spoofed_referer() --"; if (!$string_utils:is_numeric(object)) "-- it's nice to have names in the URL rather than number sometimes --"; "-- let's handle player names first --"; if ($string_utils:match_player(object) != $failed_match) "-- everything's kool --"; else "-- this name would correspond to a valid object in our db? --"; if (obidx = object in $list_Utils:slice(this.name2objnb)) "-- everything's kool --"; else "-- I guess not --"; this:error("404", object, env); endif endif endif "-- now.. IF it's a number... let's check if it's valid --"; OBJ = toobj(tonum(object)); "-- this is indeed a nb but does it refer to an existing obj_nb? --"; if (!valid(OBJ)) this:error("404", object, env); return; endif "-- Checks if the obj_nb has indeed the called verb --"; if ($object_utils:has_callable_verb(OBJ, verb) == 0) this:error("404", object, env); endif return {object, verb, data, referer_data}; endif . @verb $kahuna:"check_spoofed_referer" this none this @program $kahuna:check_spoofed_referer "-- called by $kahuna:parse_url --"; "-- checks the validity of the Referer, and sends back --"; "-- any residue passed through GET if any --"; if (caller != $kahuna) return E_PERM; else referer = $string_utils:explode(args[1], " ")[2]; "-- let's make sure the call is coming from the same server --"; server = $string_utils:explode($string_utils:explode(referer, "/")[2], ":")[1]; if (server != $network.site) "-- we need to allow local hosting...:) --"; if ($string_utils:explode(server, ".")[1] != "127") return "403"; endif endif "-- let's make sure the port through which it's coming is the one used --"; "-- by Kahuna --"; port = $string_utils:explode($string_utils:explode(referer, ":")[3], "/")[1]; if (toint(port) != $kahuna.port) return "403"; endif "-- let's make sure the object used exists --"; object = $string_utils:explode(referer, "/")[3]; if (!$string_utils:is_numeric(object)) "-- it's nice to have names in the URL rather than number sometimes --"; "-- let's handle player names first --"; if ($string_utils:match_player(object) != $failed_match) "-- everything's kool --"; else "-- this name would correspond to a valid object in our db? --"; if (obidx = object in $list_Utils:slice(this.name2objnb)) "-- everything's kool --"; else "-- I guess not --"; return "403"; endif endif endif "-- now.. IF it's a number... let's check if it's valid --"; OBJ = toobj(tonum(object)); "-- this is indeed a nb but does it refer to an existing obj_nb? --"; if (!valid(OBJ)) return "403"; endif "-- let's make sure verb exists --"; verb = $string_utils:explode($string_utils:explode(referer, "/")[4], "?")[1]; if ($object_utils:has_callable_verb(OBJ, verb) == 0) return "403"; endif return 1; endif . @verb $kahuna:"parse_form_field" this none this @program $kahuna:parse_form_field "-- called by $kahuna:parse_post --"; "-- Extracts the content of the POST process --"; "-- that is, all fields content passed through HTML forms --"; if (caller != $kahuna) return E_PERM; else count = 0; data = {}; for i in [1..length(args[1])] (ticks_left() < $kahuna.ticks_threshold) && suspend(0); if (index(args[1][i], "Content-Length:") == 1) count = 1; boundary = ""; chars = $string_utils:char_list(args[1][length(args[1])]); for y in [1..length(chars) - 2] (ticks_left() < $kahuna.ticks_threshold) && suspend(0); boundary = boundary + chars[y]; endfor endif if (count == 1) if (args[1][i] != boundary) data = {@data, args[1][i]}; endif endif endfor "-- Strips off the last entry (end boundary) --"; new_data = {}; for j in [1..length(data) - 1] new_data = {@new_data, data[j]}; endfor data = new_data; "-- puts everybody in order --"; hash = all = hash_ish = {}; for x in [1..length(data)] if (index(data[x], "Content-Disposition: form-data;") == 1) hash = {@hash, all}; all = {}; name = $string_utils:explode($string_utils:explode(data[x], "=")[2], "\"")[1]; all = {@all, name}; endif if ((index(data[x], "Content-Length: ") != 1) && (index(data[x], "Content-Disposition: form-data;") != 1)) all = {@all, data[x]}; endif endfor hash = {@hash, all}; "-- Cleans the first term --"; for k in [2..length(hash)] hash_ish = {@hash_ish, hash[k]}; endfor "-- Strips off the extra empty string coming along during POST after each field name --"; for s in [1..length(hash_ish)] hash_ish[s] = listdelete(hash_ish[s], 2); endfor return hash_ish; endif . @verb $kahuna:"register" this none this @program $kahuna:register "-- called by $kahuna:@start() --"; "-- register the software up to daddy --"; "-- Please read the doc to figure out --"; "-- what the heck is this for --"; "-- let's gather information --"; if (caller != $kahuna) return E_PERM; else site = $network.site; MOO_name = $network.moo_name; port = tostr($network.port); Aloha_port = tostr(this.port); "-- let's figure out which route to take --"; if ($network.active == 1) if ($network.maildrop != "") "-- let's pray outbound_network has been enabled --"; body = {}; body = {@body, " "}; body = {@body, "A host is running Aloha."}; body = {@body, " "}; body = {@body, "IP: ", site}; body = {@body, "Name: ", MOO_name}; body = {@body, "port: ", port}; body = {@body, " "}; body = {@body, "Aloha is listening on port: ", Aloha_port}; body = {@body, " "}; subject = "New host running Aloha"; to = "herve@hawaii.edu"; return $network:sendmail(to, subject, "Reply-to: herve@hawaii.edu", @body); endif endif "-- let's send a MOOmail in any case --"; if (typeof(TELNET = $network:open("moo.kcc.hawaii.edu", 7777)) == ERR) return; endif while (read(TELNET) != "If you already have a character, type: Connect name passwd") "-- wait for the welcome msg to pass --"; endwhile $network:notify(TELNET, "co register woNAN"); $network:notify(TELNET, "@send herve"); $network:notify(TELNET, "A host is running Aloha."); $network:notify(TELNET, " "); $network:notify(TELNET, "IP: " + site); $network:notify(TELNET, "Name: " + MOO_name); $network:notify(TELNET, "port: " + port); $network:notify(TELNET, " "); $network:notify(TELNET, "Aloha is listening on port: " + Aloha_port); $network:notify(TELNET, "."); $network:notify(TELNET, "send"); $network:notify(TELNET, "@quit"); $network:close(TELNET); endif . @verb $kahuna:"update" this none this @program $kahuna:update "-- called by $kahuna:@start() or $kahuna:@getupdate() --"; who = toobj($kahuna.operator); log = packages = {}; notify(who, "Opening connection to the update server..."); suspend(1); conn = $network:open("moo.kcc.hawaii.edu", 80); notify(conn, ("GET /" + "~moo/kccmoo/download/updates.txt") + " HTTP/1.0"); notify(conn, ""); while (typeof(line = $network:read(conn)) != ERR) log = {@log, line}; endwhile $network:close(conn); notify(who, "Closing connection to the update server..."); notify(who, "Checking the validity of data"); suspend(1); "-- let's check the output --"; if (length(log) == 2) notify(who, "There were problems retrieving the updates..."); notify(who, "Please try again using @getupdate $kahuna"); elseif ((log[9] == "Content-Type: text/plain") && (log[10] == "")) "-- everything is ok, parse the updates --"; notify(who, "Looks good."); notify(who, "Extracting updates..."); suspend(1); for x in [11..length(log)] packages = {@packages, {$string_utils:explode(log[x], ";")[1], $string_utils:explode(log[x], ";")[2]}}; endfor notify(who, "Done."); notify(who, "Checking the packages installed on your system..."); suspend(1); notify(who, tostr(length(this.modules)) + " modules have been found."); for t in [1..length(this.modules)] notify(who, " " + this.modules[t][1]); endfor notify(who, "If this not correct (missing modules), please run: @test $kahuna"); notify(who, "Do you want to continue? (y/n)"); answer = read(player); if ((((answer == "y") || (answer == "Y")) || (answer == "yes")) || (answer == "YES")) notify(player, "OK, comparing versions..."); results = {}; need_update = 0; for y in [1..length(this.modules)] found = 0; module_name = this.modules[y][1]; module_object = this.modules[y][2]; module_version = toobj(module_object).version; for z in [1..length(packages)] if (module_name == packages[z][1]) if (module_version == packages[z][2]) notify(who, ("Checking " + $string_utils:left(module_name, 30, " ..... ")) + "OK"); suspend(1); results = {@results, {module_name, "up-to-date"}}; found = 1; else notify(who, ("Checking " + $string_utils:left(module_name, 30, " ..... ")) + "NOT OK"); suspend(1); results = {@results, {module_name, "OUTDATED"}}; need_update = 1; found = 1; endif endif endfor if (found == 0) notify(who, " "); notify(who, "****************"); notify(who, "uh oh... problem..."); notify(who, "couldn't find any updates for " + module_name); notify(who, "Please drop me a mail at herve@hawaii.edu"); notify(who, "*****************************************"); notify(who, " "); found = 0; endif endfor notify(who, "Done."); suspend(1); notify(who, "Here are the results:"); notify(who, " "); notify(who, "--------------------"); for f in [1..length(results)] notify(who, $string_utils:left(results[f][1], 39, " ..... ") + results[f][2]); endfor notify(who, "--------------------"); notify(who, " "); if (need_update == 1) notify(who, "Updates can be found at: http://moo.kcc.hawaii.edu"); endif notify(who, " "); notify(who, "Updates completed."); elseif ((((answer == "n") || (answer == "N")) || (answer == "no")) || (answer == "NO")) notify(who, "Aborting."); else notify(who, "I dunno what to tell you Dude...."); endif endif . @verb $kahuna:"@getupdate" this none none @chmod $kahuna:"@getupdate" rxd @program $kahuna:@getupdate "-- called by the user to check updates manually --"; if (!player.wizard) return E_PERM; else this:update(); endif . @verb $kahuna:"@test" this none none @chmod $kahuna:"@test" rxd @program $kahuna:@test "-- called by the user to modules in Aloha --"; if (!player.wizard) return E_PERM; else who = $kahuna.operator; again = 1; raw_base_verbs = raw_base_names = base_verbs = base_names = {}; notify(who, "Ready to test Aloha Web Server."); suspend(1); notify(who, "Accessing the Update Server..."); while (again) conn1 = $network:open("moo.kcc.hawaii.edu", 80); notify(conn1, ("GET /" + "~moo/kccmoo/download/base_verbs.txt") + " HTTP/1.0"); notify(conn1, ""); while (typeof(line = $network:read(conn1)) != ERR) raw_base_verbs = {@raw_base_verbs, line}; endwhile $network:close(conn1); if (length(raw_base_verbs) == 2) again = 1; elseif (length(raw_base_verbs) > 9) again = 0; endif endwhile again = 1; while (again) conn2 = $network:open("moo.kcc.hawaii.edu", 80); notify(conn2, ("GET /" + "~moo/kccmoo/download/base_names.txt") + " HTTP/1.0"); notify(conn2, ""); while (typeof(line = $network:read(conn2)) != ERR) raw_base_names = {@raw_base_names, line}; endwhile $network:close(conn2); if (length(raw_base_names) == 2) again = 1; elseif (length(raw_base_names) > 9) again = 0; endif endwhile notify(who, "Closing connection to the update server..."); suspend(1); "-- creating base_verbs --"; if ((raw_base_verbs[9] == "Content-Type: text/plain") && (raw_base_verbs[10] == "")) for x in [11..length(raw_base_verbs)] exploded_line = $string_utils:explode(raw_base_verbs[x], ";"); base_verbs = {@base_verbs, {exploded_line[1], {}}}; for t in [2..length(exploded_line)] base_verbs[x - 10][2] = {@base_verbs[x - 10][2], exploded_line[t]}; endfor endfor else notify(who, "Brain fart... Please try again."); notify(who, "Aborting."); return; endif "-- creating base_names --"; if ((raw_base_names[9] == "Content-Type: text/plain") && (raw_base_names[10] == "")) for x in [11..length(raw_base_names)] exploded_line = $string_utils:explode(raw_base_names[x], ";"); base_names = {@base_names, {exploded_line[1], exploded_line[2]}}; endfor else notify(who, "Brain fart... Please try again."); notify(who, "Aborting."); return; endif notify(who, "The system will now scan all your objects"); notify(who, "to see if it can find any module."); notify(who, "This might take a little while..."); notify(who, " "); suspend(1); max_object = tonum($string_utils:explode($string_utils:explode(tostr(max_object()), " ")[1], "#")[1]); results = {}; for x in [95..max_object] $command_utils:suspend_if_needed(0); object = toobj("#" + tostr(x)); if (typeof($hash_utils:match_str_in_list1(base_verbs, object.name)) == LIST) position = $hash_utils:match_str_in_list1(base_verbs, object.name)[2]; notify(who, ((("found " + object.name) + " (") + tostr(object)) + ")"); notify(who, $string_utils:left("", 10, ".") + " Checking its guts..."); verbs_found = call_function("verbs", object); number_of_verbs = length(verbs_found); counter = 0; for x in [1..length(base_verbs[position][2])] if ((typeof($hash_utils:match_anystr_in_list(verbs_found, base_verbs[position][2][x])) == LIST) && ($hash_utils:match_anystr_in_list(verbs_found, base_verbs[position][2][x])[1] == 1)) counter = counter + 1; else notify(who, (((($string_utils:left("", 10, ".") + " there is a missing verb on your object... ") + tostr(object)) + ":") + base_verbs[position][2][x]) + "()"); endif endfor if ((counter == number_of_verbs) || (counter < number_of_verbs)) notify(who, $string_utils:left("", 10, ".") + " Looks good."); notify(who, $string_utils:left("", 10, ".") + " Taken in account."); notify(who, " "); else notify(who, $string_utils:left("", 10, ".") + " Incomplete object. Please install the missing verbs."); notify(who, $string_utils:left("", 10, ".") + " Taken in account anyway"); notify(who, " "); endif results = {@results, {$hash_utils:fetch(base_names, object.name), object.name, object}}; endif suspend(1); endfor notify(who, " "); notify(who, "Done."); notify(who, " "); suspend(1); notify(who, "Results:"); notify(who, "-------"); notify(who, " "); notify(who, tostr(length(results)) + " object matching valid modules have been found in your Database:"); for d in [1..length(results)] notify(who, ((" " + $string_utils:left(((results[d][1] + " (") + results[d][2]) + ")", 40, " ........... ")) + "whose object number is ") + tostr(results[d][3])); endfor notify(who, " "); notify(who, "If this is correct, type: OK"); notify(who, "For $kahuna.modules to be updated accurately."); notify(who, "If you think there is a problem, type: STOP"); answer = read(who); if ((answer == "OK") || (answer == "ok")) notify(who, "Updating $kahuna.modules property"); $kahuna.modules = $list_utils:slice(results, {1, 3}); suspend(1); notify(who, "$kahuna.modules updated succesfully."); notify(who, "Done."); elseif ((answer == "STOP") || (answer == "stop")) notify(who, "Aborting."); notify(who, "Please check your object modules."); else notify(who, "I dunno what to tell you Dude...."); notify(who, "Aborting anyway."); endif endif .