@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, "
"})}; else page = {@page, $string_utils:from_list({" | "})};
endif
page = {@page, "
"})}; else page = {@page, " Aloha Web Server"}; endif page = {@page, " Give Aloha from your MOO."}; page = {@page, " | "};
page = {@page, "
"}; page = {@page, " | |
"}; page = {@page, " | |
"};
page = {@page, "
Error ", error_type, ""})}; page = {@page, "
"})}; page = {@page, " | "};
page = {@page, "
"}; 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 .