@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)) + " :)", "<HR>"};
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 = {"<HTML>", ("<HEAD><TITLE>" + this.name) + "</TITLE></HEAD>"};
html = {@html, ((("<BODY BGCOLOR=" + this.bgcolor) + " TEXT=") + this.fgcolor) + " leftmargin=0 topmargin=0 rightmargin=0 link=#336699>"};
html = {@html, @this:generate_topbar(this.name, out.name)};
html = {@html, ("<CENTER><H1>" + this:WebParse(this:title())) + "</H1></CENTER>"};
html = {@html, "<FONT FACE=Arial>"};

if (typeof(this.description) == LIST)
  html = {@html, @this.description};
else
  html = {@html, this.description};
endif

html = {@html, "</FONT><BR><BR>"};

if (this.contents != E_PROPNF)
  html = {@html, @this:WebContents()};
endif

if (this.exits != E_PROPNF)
  html = {@html, "<BR><BR>"};
  html = {@html, @this:WebExits()};
endif

html = {@html, "<CENTER>"};
html = {@html, ("<BR><BR><HR>Generated with Ani-Web " + tostr($httpd.version)) + "<BR>", "Updates available from: ender@worfie.net", "</CENTER>"};
html = {@html, "</BODY></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:<BR>"};
for z in (this:obvious_exits())
  exitstr = ("<A HREF=" + tostr(toint(z))) + ">";
  exitstr = exitstr + tostr(z.name);
  exitstr = exitstr + "</A>";
  exitstr = ((exitstr + " to ") + tostr(z.dest.name)) + "<BR>";
  out = {@out, exitstr};
endfor
return out;
.

@verb $webbable:"WebContents" this none this rx
@program $webbable:WebContents
out = {};
for z in (this.contents)
  itemstring = "&nbsp;<A HREF=/";
  itemstring = itemstring + tostr(toint(z));
  itemstring = ((itemstring + ">") + z:title()) + "</A>";
  out = {@out, itemstring};
endfor
if (out != {})
  return {this:contents_msg(), @out};
else
  return {"<!--No contents-->"};
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 = ("<FONT COLOR=" + code[2]) + ">";
      first = 1;
    else
      sub = ("</FONT><FONT COLOR=" + code[2]) + ">";
    endif
    z = strsub(z, code[1], sub);
  endfor
  z = strsub(z, "[normal]", "</font>");
  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, "<", "&lt;");
string = strsub(string, ">", "&gt;");
return string;
.

@verb $webbable:"generate_topbar" this none this
@program $webbable:generate_topbar
barbg = "#e7e7e7";
barbg2 = "#c0c0c0";
barbg3 = "#6f6f6f";
out = {"<table cellspacing=0 cellpadding=0 width=100% border=0>"};
out = {@out, ("<tr bgcolor=" + barbg) + ">"};
out = {@out, "<td><img src=\"\" width=1 height=2 alt=\"\"></td>"};
out = {@out, "</tr>"};
out = {@out, "</table>"};
out = {@out, "<table cellspacing=0 cellpadding=1 width=100% border=0>"};
out = {@out, ("  <tr valign=middle bgcolor=" + barbg2) + ">"};
out = {@out, "<td align=left><b>", args[1], "</b></td>"};
out = {@out, "<td align=right><i>(", args[2], ")</i></td>"};
out = {@out, "<table cellspacing=0 cellpadding=0 width=100% border=0>"};
out = {@out, ("  <tr valign=middle bgcolor=" + barbg3) + ">"};
out = {@out, "    <td><img src=\"\" width=1 height=1 alt=\"\"></td>"};
out = {@out, "  </tr>"};
out = {@out, ("  <tr bgcolor=" + barbg) + ">"};
out = {@out, "    <td><img src=\"\" width=1 height=1 alt=\"\"></td>"};
out = {@out, "  </tr>"};
out = {@out, "</table>"};
out = {@out, "</tr>", "</table>"};
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, "<HTML><TITLE>Access Denied</TITLE></HEAD>"};
html = {@html, "<BODY BGCOLOR=" + $webbable.bgcolor + " TEXT=" + $webbable.fgcolor + " leftmargin=0 rightmargin=0 topmargin=0 link=#336699>"};
html = {@html, @$webbable:generate_topbar(this.dest.name, out.name)};
html = {@html, "<B><PRE><FONT FACE=Arial>"};
html = {@html, tostr(this.nogo_msg)};
html = {@html, "</FONT></PRE></B>"};
html = {@html, "</BODY></HTML>"};
return html;
.

;;player:tell_lines({"Webserver installed. Please run these chparents: (if this fails,","set $server_options.protect_chparent to 0)","","@chparent <$thing parent> to $webbable","@chparent <$room parent> to $webbable","@chparent <$player parent> to $webbable","","By parent, I mean if you have $room set to Generic Detailed Room, ","which is a child of Room with seats, which is a child of Generic Room (#3)..","@chparent #3 - the one before #1 (Root Class).","","Then change ;$httpd.port and 'start web server' :)","Oh yeah, and make sure $network.site is set to your DNS name/ip","Need assistance? E-mail ender@worfie.net"});