@create $thing named Web Server:Web Server,WWW,httpd
@rmprop #0.httpd
@corify httpd as $httpd
@prop $httpd."port" 70 rc
@prop $httpd."calls" {} rc
;$httpd.calls = {"index", "login"}
@prop $httpd."base64" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" rc
@prop $httpd."help_msg" {} rc
@edit $httpd.help_msg
enter
Ender/Amigo's Generic Web Server
-------------------------------------
(For updates, e-mail ender@enderboi.com)
-------------------------------------
This object, $httpd, contains all the verbs
needed for the main handling of HTML requests.
$webbable (Generic Webbable) contains all the
properties and verbs for returning most actual
HTML responses from individual objects.
Operation
---------
Upon recieving a HTML request, this object first
searches it's .call's property, which contains a
list of verbs on $httpd itself which are callable.
If the URL requested doesn't exist on $httpd, the
server treats it as an object and attempts to call
:_html on it.
Eg:
http://moo.server:port/54
The Web Server will attempt to execute #54:_html.
To this verb, it will pass two arguments. The first
is the exact page requested, the second a list of
headers the web browser passed to the server.
Note the server will also try and check the page against
corified objects (eg http://moo.server:port/$httpd)
All :_html and other callable verbage should return
valid HTML -AS A LIST-.
The following properties are available:
$httpd.port - The port this server listens on
$httpd.calls - Contains a list of verbs on $httpd
accessable directly (eg, with
http://moo.server:port/verbname)
The following verbs are available (help $httpd:verbname
for more information on each of these):
$httpd:start - Frontend to $httpd:server_started.
Allows user to type 'start $httpd'
$httpd:server_started - Starts the web server listening
$httpd:do_login_command - Parses the initial client connection
$httpd:do_get - Searches for a valid object/verb, and
executes it (for GET requests only)
$httpd:do_post - As above, but for POST requests
$httpd:error - Return an error page
$httpd:index - A wrapper to the page to use by default.
$httpd:authorise - Used to force a player to login via WWW
$httpd:GetVariable - Return one of the header values
$httpd:from64 - De-Base64 encode something
.
save
done
@prop $httpd."noauth" 0 rc
@prop $httpd."version" 0.4 rc
;;$httpd.("aliases") = {"Web Server", "WWW"}
;;$httpd.("description") = {"You see a small black cube, with a speaker mounted on one side, and a small power light on the top. There is one button next to the light labelled 'Stop'"}
@verb $httpd:"start" this none none
@program $httpd:start
if ((caller != #0) && (!caller.wizard))
player:tell("The cube bleeps, and a female voice whispers 'Access Denied'");
endif
result = this:server_started();
if (typeof(result) == INT)
player:tell("The cube bleeps, and a female voice whispers 'System Online'");
else
player:tell("The cube bleeps, and a female voice whispers 'System Failure'");
endif
.
@verb $httpd:"do_login_command" none none none rx
@program $httpd:do_login_command
args = $string_utils:explode(argstr, " ");
what = args[1];
where = args[2];
if (!what)
return;
endif
if ((what != "POST") && (what != "GET"))
player:notify("501 Method Not Implimented");
boot_player(player);
endif
envirovars = "";
while (1)
string = read(player);
if (string == "")
break;
endif
envirovars = (envirovars + "***") + string;
endwhile
if (what == "POST")
this:do_post(args[2], envirovars);
endif
if (what == "GET")
this:do_get(args[2], envirovars);
endif
return 0;
.
@verb $httpd:"do_get" this none this rx
@program $httpd:do_get
where = $string_utils:explode(args[1], "/");
connection = player;
if (where[1] == E_RANGE)
where = {"index"};
endif
if (where[1] in this.calls)
out = this:(where[1])(args[1], args[2]);
else
out = #0.(where[1]):_html(args[1], args[2]);
if (typeof(out) == ERR)
out = toobj(where[1]):_html(args[1], args[2]);
if (out == E_VERBNF)
out = this:error(where[1], 404);
endif
endif
endif
for line in (out)
notify(connection, line, 1);
$command_utils:suspend_if_needed(1);
if (!(connection in connected_players(1)))
return;
endif
endfor
boot_player(connection);
.
@verb $httpd:"error" none none none rxd
@program $httpd:error
where = args[1];
code = args[2];
return {"Server Error: ", tostr(code)};
.
@verb $httpd:"index" none none none rxd
@program $httpd:index
return $player_start:_html(@args);
.
@verb $httpd:"server_started" this none this rx
@program $httpd:server_started
return listen(this, this.port);
.
@verb $httpd:"look_self" this none this rx
@program $httpd:look_self
player:Tell_lines(this.description);
for z in (listeners())
if (z[1] == this)
player:tell("The power light is on.");
return;
endif
endfor
player:tell("The power light is off.");
.
@verb $httpd:"authorise" none none none rx
@program $httpd:authorise
whom = #-1;
pwd = "notvalid";
out = {};
basic = $httpd:GetVariable(args[2], "Authorization");
basic = basic[8..$];
if (basic)
plaintext = $httpd:from64(basic);
pwdpair = $string_utils:explode(plaintext, ":");
whom = $string_utils:match_player(pwdpair[1]);
if (valid(whom))
pwd = crypt(pwdpair[2], whom.password);
endif
endif
if (whom.password == 0)
return whom;
endif
if (pwd == whom.password)
return whom;
endif
out = {@out, "HTTP/1.1 401 Access Denied", "WWW-Authenticate: Basic realm=\"MOO Login\""};
out = {@out, "", "You must enter a valid MOO username/password to access this resource"};
return out;
.
@verb $httpd:"GetVariable" this none this
@program $httpd:GetVariable
envirovars = args[1];
variables = $string_utils:explode(envirovars, "***");
for z in (variables)
string = $string_utils:explode(z, ":");
if (string[1] == args[2])
return string[2];
endif
endfor
return "";
.
@verb $httpd:"from64" this none this rx
@program $httpd:from64
"This code stolen from $math_utils:from64 @ Midgard";
"Thanks Marty :)";
":from64(STR base64-encoded input) => STR decoded output";
Out = {};
Input = args[1];
for I in [1..length(Input)]
if (Input[I] != "=")
Char = index(this.base64, Input[I], 1) - 1;
Out = {@Out, Char};
endif
if ((ticks_left() < 2000) || (seconds_left() < 2))
suspend(0);
endif
endfor
Bin = "";
for I in (Out)
Bin = Bin + $string_utils:right($math_utils:base_conversion(I, 10, 2), 6, "0");
if ((ticks_left() < 2000) || (seconds_left() < 2))
suspend(0);
endif
endfor
Out = "";
for I in [1..length(Bin) / 8]
Char = Bin[((I - 1) * 8) + 1..((I - 1) * 8) + 8];
Out = Out + $string_utils:from_ascii(tonum($math_utils:base_conversion(Char, 2, 10)));
if ((ticks_left() < 2000) || (seconds_left() < 2))
suspend(0);
endif
endfor
return Out;
.
@verb $httpd:"test" this none this rx
@program $httpd:test
"Example of authentication";
authorised = $httpd:authorise(@args);
if (typeof(authorised) == LIST)
return authorised;
endif
out = {("Your an OK user, " + tostr(authorised)) + " :)", "
"};
return out;
.
@verb $httpd:"login" this none this rx
@program $httpd:login
if ($httpd.noauth)
$httpd.noauth = 0;
return $httpd:index(@args);
else
$httpd.noauth = 1;
return $httpd:authorise("", "");
endif
.
@create $root_class named Generic Webbable:Generic Webbable,GW
@rmprop #0.webbable
@corify GW as $webbable
@prop $webbable."fgcolor" "#000000" rc
@prop $webbable."bgcolor" "#FFFFFF" rc
@prop $webbable."contents_msg" "Looking around, you see:" rc
@prop $webbable."WebAnsi" {} rc
;;$webbable.("WebAnsi") = {{"[red]", "red"}, {"[green]", "green"}, {"[blue]", "blue"}, {"[purple]", "purple"}, {"[cyan]", "cyan"}, {"[yellow]", "yellow"}}
;;$webbable.("aliases") = {"Generic Webbable", "GW"}
;;$webbable.("description") = "This parent provides a basic set of functionality to allow MOO objects to be viewed from the World Wide Web. It's not perfect, and is only really meant as a base class to build on. But it does do it's job pretty damn well, if I say so myself. == Ender"
@verb $webbable:"_html" none none none rx
@program $webbable:_html
out = $httpd:authorise(@args);
if (typeof(out) == LIST)
return out;
endif
html = {"", ("" + this.name) + ""};
html = {@html, (((""};
html = {@html, @this:generate_topbar(this.name, out.name)};
html = {@html, ("" + this:WebParse(this:title())) + "
"};
html = {@html, ""};
if (typeof(this.description) == LIST)
html = {@html, @this.description};
else
html = {@html, this.description};
endif
html = {@html, "
"};
if (this.contents != E_PROPNF)
html = {@html, @this:WebContents()};
endif
if (this.exits != E_PROPNF)
html = {@html, "
"};
html = {@html, @this:WebExits()};
endif
html = {@html, ""};
html = {@html, ("
Generated with Ani-Web " + tostr($httpd.version)) + "
", "Updates available from: ender@worfie.net", ""};
html = {@html, ""};
html = {"HTTP/1.1 200 OK", "Connection: close", "Content-Type: text/html", "", @html};
return this:WebAnsi(@html);
.
@verb $webbable:"WebExits" this none this rx
@program $webbable:WebExits
out = {"You can go:
"};
for z in (this:obvious_exits())
exitstr = ("";
exitstr = exitstr + tostr(z.name);
exitstr = exitstr + "";
exitstr = ((exitstr + " to ") + tostr(z.dest.name)) + "
";
out = {@out, exitstr};
endfor
return out;
.
@verb $webbable:"WebContents" this none this rx
@program $webbable:WebContents
out = {};
for z in (this.contents)
itemstring = " ") + z:title()) + "";
out = {@out, itemstring};
endfor
if (out != {})
return {this:contents_msg(), @out};
else
return {""};
endif
.
@verb $webbable:"contents_msg" this none this
@program $webbable:contents_msg
return $string_utils:pronoun_sub(this.contents_msg, this);
.
@verb $webbable:"WebAnsi" this none this rx
@program $webbable:WebAnsi
out = {};
first = 0;
replacestring = "";
for z in (args)
$Command_Utils:Suspend_if_needed(0);
for code in (this.WebAnsi)
$Command_Utils:Suspend_if_needed(0);
first = 0;
if (first == 0)
sub = ("";
first = 1;
else
sub = ("";
endif
z = strsub(z, code[1], sub);
endfor
z = strsub(z, "[normal]", "");
z = strsub(z, "[random]", "");
z = strsub(z, "[bold]", "");
z = strsub(z, "[unbold]", "");
out = {@out, z};
endfor
return out;
.
@verb $webbable:"WebParse" this none this rx
@program $webbable:WebParse
string = args[1];
string = strsub(string, "<", "<");
string = strsub(string, ">", ">");
return string;
.
@verb $webbable:"generate_topbar" this none this
@program $webbable:generate_topbar
barbg = "#e7e7e7";
barbg2 = "#c0c0c0";
barbg3 = "#6f6f6f";
out = {""};
out = {@out, (""};
out = {@out, " | "};
out = {@out, "
"};
out = {@out, "
"};
out = {@out, ""};
out = {@out, (" "};
out = {@out, "", args[1], " | "};
out = {@out, "(", args[2], ") | "};
out = {@out, ""};
out = {@out, (" "};
out = {@out, " | "};
out = {@out, "
"};
out = {@out, (" "};
out = {@out, " | "};
out = {@out, "
"};
out = {@out, "
"};
out = {@out, "
", "
"};
return out;
.
@verb $exit:_html tnt rx
@program $exit:_html
out = $httpd:authorise(@args);
if (typeof(out) == LIST)
return out;
endif
newloc = $network.site + ":" + tostr($httpd.port) + "/";
newloc = newloc + tostr(toint(this.dest));
newloc = "http://" + newloc;
if (this:is_unlocked_for(out))
return {"HTTP/1.1 301 Moved Permanently", "Location: " + newloc, "Connection: close", "Content-Type: text/html", "", "Redirect"};
endif
html = {"HTTP/1.1 200 OK", "Connection: close", "Content-Type: text/html", ""};
html = {@html, "Access Denied"};
html = {@html, ""};
html = {@html, @$webbable:generate_topbar(this.dest.name, out.name)};
html = {@html, ""};
html = {@html, tostr(this.nogo_msg)};
html = {@html, "
"};
html = {@html, "