( ProtoHTTPd by Akari and Nodaitsu                                           )
(            Nakoruru08@hotmail.com                                          )
( Version 0.1  - Initial version of ProtoHTTPd                               )
( Version 0.2  - Started over on the core, redesigned around MUF sockets.    )
( Version 0.9  - Approaching completion. 09/18/02                            )
( Version 1.0  - Ready for beta testing. 10/02/02                            )
( Version 1.1  - Fixed the index listing from having extra '/' marks. 1/9/03 )
(                Added a faster algorithm for sending plaintext files.       )
( Version 1.2  - Fixed all the problems related to closing connections too   )
(                early. 01/14/03                                             )
( Version 1.21 - Fixed a bug with server-side directory listing if the site  )
(                had no root webpage in-muck. 01/20/03                       )
( Version 1.22 - Fixed the 'lastcon' timestamp to be accurate.               )
(                                                                            )
(  The goal of the project was to create a webserver with the following:     )
(     Virtual hosts: <player>.<site address>:<port>/<page>                   )
(     Virtual Directories                                                    )
(     MUF CGI using GET: Traditional in-server webserver behavior with MUF.  )
(     MUF CGI using POST: POST form compatability.                           )
(     Web Page hosting using lsedit lists: Traditional in-server behavior.   )
(     HTTPd compliant headers: Old webserver didn't do these.                )
(     Binary passthrough: Be able to send pictures/files from the server     )
(     URL Redirection: Old webserver supported this.                         )
(  Because this MUF webserver can be of use to probably every site, I am     )
(     considering it to be part of the general ProtoMUCK project until a     )
(     comperable in-server version is added someday down the line. This means)
(     feature requests and bug reports can be submitted to the project site: )
(     http://sourceforge.net/projects/protomuck                              )

( Setup:
    Currently requires ProtoMUCK 1.8b6 or newer. 
    Install this program and $lib/cgi 2.0 or newer. 
    Check the Preference $defines below. 
    If you will be using server-side support as well, make a:
        proto/game/files/public_html folder, or $define an alternate folder
        below. 
    Set the webserver = AUTOSTART if you would like it to run whenever the
        MUCK is started. 
    Link a '@webserver' action to the program.     
    Enter '@webserver #config' to set initial preferences. 
    Enter '@webserver start' to start the webserver up. It will prompt for
        the listening port you would like to use.
) 

( Compatability notes regarding switching from in-server Web Server: 
      Any MUF CGI program that used the 'descr' value passed in the string
          argument at the start of the program will work perfectly fine. 
      MUF programs MUST be set LINK_OK. This is a change from before. 
      Any MUF CGI programs that used the DESCR prim will need to be modified.
         Stick these declarations at the top of the program: 
            $def parseweb "|" explode pop atoi theDescr ! host ! user ! params !
            $def descr theDescr @
            lvar theDescr lvar user lvar host lvar params
         And insert this immediately before the first line in main:
            dup parseweb
      If the MUF CGI generates its own header, '@set <prog>=_type:noheader'
          to keep the webserver from generating its header for it.
      The custom 404 error page will have to be moved to the correct location
          on the webserver program. See '@webserver #info1' for details.    
)
( Design Notes: 
    Notice that all outgoing data is sent via NOTIFY_DESCRIPTOR rather than
        SOCKSEND. This was so that the connection will be non-blocking and
        be able to use the in-server output queue, essential for slower
        connections.
    A SOCKTODESCR prim is used to convert the incoming MUF socket into
        a valid descriptor. This behavior will have to be disabled
        when working with any MUF CGI intended to allow players to login.
    The SOCKSHUTDOWN prim had to be used in place of SOCKCLOSE. This is 
        due to the quirky way in which all browsers expect their sessions to
        end with webservers. See Apache design notes for details. 
)
( TODO in Next Version: 
        Add a prim for file transfer purposes. Will send blocks of data
            instead of 1 byte at a time. [ in progress ]
        A way to disable the SOCKTODESCR call in case SOCK_SETUSER is
            to be used for a web-login MUF. 
        The MaxInstances choke isn't working right yet due to a bug in the
            INSTANCES prim. Add 11 to how many max instances you
            -really- want to support. i.e., 16 if you want to support 5
            until this bug is fixed. 
        At the moment, the #stats bytes-sent thingy doesn't include
            anything sent via Web CGI. Trying to think if I should come
            up with a way to fix that. 
)

$author Akari and Nodaitsu
$version 1.22
 
(** Required Includes ** )
$include $lib/cgi      ( Requires version 2.0 or newer. )
$include $lib/strings  ( Requires version 2.0 or newer. )

(** Preference defines **)
(* Define this to have unknown files sent as ASCII. Normally unknown files
 * are sent as octet streams per HTTPd standard )
$undef defaultText

(* Time to wait before deciding that a read socket isn't going to send
 * anything. 60 seconds is usually a safe bet. )
$def readTimeout 60  
 
(* If the MUCK was compiled with WWW support, then the @tune www_root 
 * will be used. Otherwise $define the following dbref to be the root.
 *)
$def defaultWebRoot #205
 
(* Set this to the size of data blocks for binary sending. Must be less than
 * 4096. Smaller blocks reduce the chance of impacting the MUCK's performance,
 * but make the file sending go slower. )
$def blocksize 10

(* This is the max queued connections waiting to be accepted on the web port *)
$def port_queue 5 ( 5 is safe and typical. )
 
(* The log file if file prims are enabled. *)
$def logfile "$LOGS/webserver" 
 
(* Tells the browser how long it should cache your data in seconds. *)
$def aging 600  ( 10 minutes is the default )
 
(* Indicates that it's a player name to look for. http://host.com/~player )
$def PlayerToken "~"  ( ~ is a good standard )
 
(* Web Directories. Where to actually look for web stuff. Don't end with / *)
$def WebDir "_/www" ( NeonMUCK defaulted to _/www ) 
 
(* Set this to be the folder that should be used as the on-server directory. *)
$def ServerDir "public_html" ( defaults to proto/game/files/public_html/ )
 
(* Uncommenting this will disable server-side support and logging.           *)
($undef HAVE_FILE_PRIMS)
 
$ifdef HAVE_FILE_PRIMS  
$ansi ^VIOLET^Compiling with Server-Side Support.
$else
$ansi ^BROWN^Compiling without Server-Side Support.
$endif
 
$ifndef HAVE_SOCKET_PRIMS
$ansi ^CRIMSON^This MUCK was compiled without socket prims. Compiling aborted.
$abort No socket support compiled in.
$endif

(** Program $defines **)
$def pHTTPdVer "1.22"  
$def atell me @ swap ansi_notify
$def dtell theDescr @ swap notify_descriptor
$def BUFFER_LEN  12288
$define stell
    theSock @ sockdescr dup descr? not if pop pop 
    else 
        dup rot notify_descriptor 
        getdescrinfo "OUTPUT_LEN" array_getitem bytesOut !
    then
$enddef

$undef HAVE_SEND_BINARY (don't enable this, unless you know what you're doing)

(** Global variables **)
lvar theDescr    ( The descr recieved from SOCKTODESCR in that instance       )
( Dictionaries and Arrays )
lvar mimeTypes   ( Dictionary of file extentions and their mime types.        )
lvar functionMap ( Dictionary of data types and the function to call for them )
lvar defaultHomes (Array of default 'home' URLs to look for.                  )
lvar errorMesgs  ( Dictionary of error codes and messages                     )
( Bools )
lvar logging     ( bool to indicate if logging is on or not                   )
lvar debugging   ( bool to indicate if more detailed debug should go to owner )
lvar allowVhosts ( bool to indicate if virtual hosts are allowed.             )
lvar allowBinary ( bool to indicate if binary pass through is enabled         )
lvar logwallWizs ( bool to indicate of wizzes should be logwalled             )
lvar allowPlayer ( bool to indicate if players can have their own webpages.   )
lvar playerCGI   ( bool to indicate if players can have MUF CGI or not.       )
lvar ServerOff   ( bool to indicate if server is disabled currently.          )
lvar MaxFileSize ( int to indicate the max bytes to send for a file.          )
lvar keepStats   ( bool to indicate stats should be kept.                     )
lvar debugSend   ( bool to echo sends to owner.                               )
lvar redirection ( bool for allowing URL redirection                          )
lvar BytesOut    ( int used for tracking the number of bytes sent.            )
lvar verNum      ( Number of httpd compatability.                             )
lvar maxInstance ( Number of clients to serve simultaneously. 0 = no limit.   )
 
(** Helper Tools **)
: webroot ( -- d )
  (* Will always return the web root *)
    "www_root" sysparm dup if
        stod
    else
        pop defaultWebRoot
    then
    dup room? not if pop
        "Error: Need to @tune or $define a valid Webserver Host" abort
    then
;

: time-to-str[ int:theTime -- str:timeStr ]
  (* Prints time durations in days, hours, minutes. *)
  "" var! timeStr
    theTime @ 86400 / dup if dup 1 = if " day" else " days" then
        swap intostr swap strcat timeStr !
        theTime @ 86400 % theTime !
    else pop 
    then
    theTime @ 3600 / dup if dup 1 = if " hour" else " hours" then
        swap intostr swap strcat
        timeStr @ dup if ", " strcat then swap strcat timeStr !
        theTime @ 3600 % theTime !
    else pop 
    then
    theTime @ 60 / dup if dup 1 = if " minute" else " minutes" then
        swap intostr swap strcat
        timeStr @ dup if ", " strcat then swap strcat timeStr !
        theTime @ 60 % theTime !
    else pop
    then 
    theTime @ dup if dup 1 = if " second" else " seconds" then
        swap intostr swap strcat
        timeStr @ dup if ", " strcat then swap strcat timeStr !
    else pop
    then
    timeStr @
;
 
: check-prefs ( -- ) 
  (* Call periodically to update preferences, like logging and debugging )
  (* Using 'not not' because it's faster to pass ints around than strings )
    prog "@web/log" getprop not not logging !  
    prog "@web/debug" getprop not not debugging !
    prog "@web/vhosts" getprop not not allowVhosts !
    prog "@web/binary" getprop not not allowBinary !
    prog "@web/logwall" getprop not not logwallWizs !
    prog "@web/players" getprop not not allowPlayer ! 
    prog "@web/playerCGI" getprop not not playerCGI !
    prog "@web/offline" getprop not not serverOff !
    prog "@web/maxfile" getprop maxFileSize !
    prog "@web/keepstats" getprop not not keepStats !
    prog "@web/debugSend" getprop not not debugSend !
    prog "@web/redirect" getprop not not redirection !
    prog "@web/maxInstances" getprop MaxInstance !
;
 
: get_sessionID ( -- s )
  (* Every connection recieves a unique ID. Reset to 1 when webserver starts *)
    prog "@web/lastSID" getpropval 1 + 
    prog over "@web/lastSID" swap setprop intostr
;

: do-logwall[ str:mesg -- ]
  (* Sends a LOG> message to all LOGWALL set players online *)
    online_array foreach swap pop
        dup "LOGWALL" flag? if 
            mesg @ ansi_notify
        else pop
        then
    repeat
;

: do-log[ str:mesg int:debugOnly -- ]
 (* Date/time stamps the message and appends it to the log file. 
  * Does debug output too if that's enabled. Some things are only
  * logged if the debugOnly parameter is true. )
    debugOnly @ debugging @ not and if exit then
    mesg @ "\r" strcmp not if exit then
$ifdef HAVE_FILE_PRIMS
    BUFFER_LEN 30 - mesg @ strlen > if (don't timestamp if will overflow buffer)
        "%x %X: " systime timefmt mesg @ strcat
    else mesg @
    then
    logfile fappend not if
        "^CRIMSON^Unable to open log file." atell 
    else
        logfile fcr pop
    then
$endif
    debugging @ if
        BUFFER_LEN 30 - mesg @ strlen > if
            "^BROWN^%x %X: ^FOREST^" systime timefmt mesg @ strcat 
        else ( message too big for special formatting )
            mesg @
        then atell
    then
    logwallWizs @ if
        debugOnly @ debugging @ and debugging @ not or if
            BUFFER_LEN 30 - mesg @ strlen > if
                "^WHITE^LOG> ^NORMAL^" mesg @ strcat 
            else
                mesg @ ( message to big for prepending )
            then
            do-logwall
        then
    then
;
 
(** Socket input/output functions. **)
: sockread-line[ sock:theSock -- s ]
  (* Only reads in 1 line from the socket and returns it to the stack. 
   * A completely empty string indicates a timeout                     )
    readTimeout "TIMEOUT" timer_start
    begin
        { "SOCKET.READ*" "TIMER.TIMEOUT" "USER.SHUTDOWN" }list
        event_waitfor "TIMEOUT" instr if pop "" break then
        nbsockrecv dup if ( the string has something ) 
            swap pop break
        else ( string is empty, check for byte count )
            swap 0 > if ( it is a newline )
                pop "\r" break
            else ( it is an empty line ) 
                pop
            then
        then
    repeat
    "TIMEOUT" timer_stop 
    logging @ debugging @ and if dup 1 do-log then
;
 
: send-list[ arr:mesg sock:theSock -- int:connected ]
  (* Sends the strings to the socket. Returns 0 if the connection drops *)
    mesg @ foreach swap pop
        debugSend @ if ( echo sends to owner )
            "^NAVY^<< " over strcat atell
        then
        theDescr @ descr? not if pop 0 exit then ( connection dropped )
        theDescr @ swap notify_descriptor 
    repeat  
    ( set new bytesOut value )
    theDescr @ getdescrinfo "OUTPUT_LEN" array_getitem bytesOut !     
    1
;

: close-connection[ sock:theSock dict:sockInfo -- ]
  (* Writes out the meta tags if connection still valid, then closes socket. *)
  var counter   ( used to prevent infinte loops  )
  var lastCount ( used to prevent infinite loops )
  var meta? 
    sockInfo @ "meta" array_getitem 
    dup string? if "no" stringcmp meta? ! 
    else pop
    then
    keepStats @ if
        prog "@web/bytesOut" getpropval bytesOut @ + 
        prog swap "@web/bytesOut" swap setprop ( update bandwidth data )
    then
    theDescr @ descr? meta? @ and if
        "<META NAME=\"server\" CONTENT=\""
        version strcat ":" strcat
        "ProtoHTTPd/" pHTTPdVer strcat strcat
        " -- Akari and Nodaitsu.\">\r\n" strcat stell 
    then 
    begin ( delay loop to make sure all data is sent first )
        theDescr @ descr? not if break then
        theDescr @ getdescrinfo "OUTPUTQUEUE" array_getitem 
        dup not if pop break then ( queue empty, safe to close connection )
        dup lastCount @ = if pop
            counter ++ 
        else 
            0 counter !
            lastCount !
        then
        1 sleep
        counter @ 100 > if break then ( end the infinite loop )
        0 sleep
    repeat
    ( Now check for any remaining acknowledgement packets )
    theSock @ 1 sockshutdown pop 
    2 sleep 0 counter ! 
    begin 
        theSock @ nbsockrecv pop dup not swap -1 = or if break then
        2 sleep
        counter ++ counter @ 30 > if break then
    repeat
    theDescr @ dup descr? if descrboot else pop then 
;
 
(** Webserver main functions and loops **)
 
: make-header-nolen[ str:type -- arr:theHeader ]
  (* Writes out our header for processes where the length is not pre-known *)
  type @ "noheader" stringcmp not if ( allows one to prevent sending a header )
      0 array_make exit
  then
  {  
      "HTTP/" verNum @ strcat " 200 OK\n" strcat
      "Date: %a, %d %b %Y %T GMT\n" systime gmtoffset + timefmt 
      "Server: ProtoHTTPd/" pHTTPdVer strcat "\n" strcat
      verNum @ "1.1" strcmp not if
          "Cache-Control: max-age=" aging intostr strcat "\n" strcat
      then
      "Expires: %a, %d %b %Y %T GMT\n" systime gmtoffset + aging + timefmt 
      verNum @ "1.1" strcmp not if
          "Connection: close\r\n"
      then
      "Content-Type: " type @ strcat "\n" strcat
      "\r\n" 
  }list 
;
 
: make-header[ str:type str:length int:modified -- arr:theHeader ]
  (* Makes header for server-side files where more is certain *)
  {
      "HTTP/" verNum @ strcat "200 OK\n" strcat
      "Date: %a, %d %b %Y %T GMT\n" systime gmtoffset + timefmt 
      "Server: ProtoHTTPd/" pHTTPdVer strcat "\n" strcat
      "Cache-Control: max-age=" aging intostr strcat "\n" strcat
      "Expires: %a, %d %b %Y %T GMT\n" systime gmtoffset + aging + timefmt 
   (   "Last-Modified: %a, %d %b %Y %T GMT\n" modified @ gmtoffset + timefmt )
      "Connection: close\n" 
   (   "Content-Length: " length @ strcat "\n" strcat )
      "Content-Type: " type @ strcat "\n" strcat
      "\n" 
  }list
;

: send-errormesg[ str:theCode sock:theSock dict:sockInfo str:mesg -- ]
  (* Prepares and sends the error pages. Accepts custom messages in the
   * 'mesg' parameter. )
  var usedMesg ( a bool to indicate if mesg has been shown yet )
    logging @ if 
        "SID: " sockInfo @ "SID" array_getitem 
        dup string? if strcat else pop then
        " encountered an error: " strcat theCode @ strcat 0 do-log
    then
    { ( make the header array )
      "HTTP/" verNum @ strcat " " strcat theCode @ strcat " " strcat 
      errorMesgs @ theCode @ array_getitem 
      dup string? if strcat else pop then "\n" strcat
      "Date: %a, %d %b %Y %Y GMT\n" systime gmtoffset + timefmt
      "Server: ProtoHTTPd/" pHTTPdVer strcat "\n" strcat
      "Connection: close\n" 
      "Content-type: text/html\n" 
      " \n"
    }list theSock @ send-list not if
        logging @ if 
            "SID: " sockInfo @ "SID" array_getitem 
            dup string? if strcat else pop then
            " timedout while sending error header: " theCode @ strcat 1 do-log
            exit
        then
    then
    prog "@web/pages/" theCode @ strcat propdir? if ( custom error message )
        prog "@web/pages/" theCode @ strcat array_get_proplist 
        theSock @ send-list not if
            logging @ if 
                "SID: " sockInfo @ "SID" array_getitem strcat
                " timed out while sending error: " theCode @ strcat 1 do-log
                exit
            then
        then theSock @ sockInfo @ close-connection exit
    then
    ( no custom list, send the standard )
    
    { ( Make standard message page list )
        "<HTML><HEAD><TITLE>" theCode @ strcat " " strcat
        errorMesgs @ theCode @ array_getitem strcat
        "</TITLE></HEAD>" strcat
        "<BODY BGCOLOR=#FFFFFF TEXT=#000000>"
        "<TABLE WIDTH=600 BGCOLOR=0000BB CELLPADDING=5 CELLSPACING=0 "
        "BORDER=0>" strcat
        "<TR>" 
        "  <TD ALIGN=LEFT width = 150><font color=\"#FFFFFF\" size=+4><b>" 
        theCode @ strcat 
        "</b></font></TD>" strcat ( Maybe do something with these later )
        "  <TD ALIGN=left WIDTH=450><font size=+2 color=\"#FFFFFF\">"
        prog "@web/mesgs/" theCode @ strcat getpropstr dup not if pop
            mesg @ dup not if 
                pop "No info is available about this code." 
            else 1 usedMesg !
            then
        then 
        "</font></TD>"  strcat        
        "</TR>"  strcat 
        "</TABLE><BR>" strcat
        
        "<FONT FACE=Courier>"
        usedMesg @ not if mesg @ then
        "<HR align=left width=600>"
        "  <LI>Session ID Code: " 
        sockInfo @ "SID" array_getitem dup not if pop "<None>" then strcat
        "  <LI>Requested Method: " 
        sockInfo @ "METHOD" array_getitem dup not if pop "<Unknown>" then strcat
        "  <LI>Attempted URL: " 
        sockInfo @ "headerdata" array_getitem dup array? if
            "host" array_getitem 
        else pop 0
        then
        dup not if pop "<unknown>" then strcat 
        sockInfo @ "TheDEST" array_getitem  
        dup not if pop "/<unknown>" then strcat
        "  <LI>CGI Parameters: " sockInfo @ "CGIParams" array_getitem dup
                                 not if pop "None." then strcat     
        "<HR align=left width=600>"   
        "    ProtoHTTPd/" pHTTPdVer strcat " running on " strcat
        version strcat "</FONT>" strcat 
        "</BODY></HTML>"
    }list theSock @  send-list not if  
        logging @ if 
            "SID: " sockInfo @ "SID" array_getitem strcat
            " timedout while sending error page: " theCode @ strcat 1 do-log
            exit
        then
    then
    theSock @ sockInfo @ close-connection
;
: get-rootObj[ str:theHost str:theDest 
    -- dbref:rootObj str:rootDir str:theDest ]
  (* Returns the dbref and  directory that should be searched. *)
  (* Rules: 1. Virtual hosts take priority over player redirection. E.g.:
               http://akari.frogpond.dynodns.net/~skuld/ would resolve
               'Akari' as the root object, if Akari and Skuld are both
               players.
            2. Player redirection takes priority over root object if allowed.
               http://frogpond.dynodns.net/~akari will resolve to 'Akari'.
            3. If a @vhost/ prop points to #-1, then only on-server
               files will be checked, if server-side support exists. )
  #-1 var! tempObj 
  ""  var! tempDir 
  0   var! isVHost
      var  tempURL
    theHost @ not if  "servername" sysparm theHost ! then
    theHost @ ":" split pop tempURL !
    allowVhosts @ if ( check the @vhosts/ propdir first )
        prog "@vhosts/" tempURL @ strcat propdir? if ( virtual host found )
            prog "@vhosts/" tempURL @ strcat "/rootObj" strcat getprop
            dup dbref? not if stod then tempObj !
            prog "@vhosts/" tempURL @ strcat "/rootDir" strcat getprop tempDir !
            1 isVhost !
        else ( not stored as a prop, check for a matching player )
             ( TODO: This may be a problem if the muck's URL has a possible
                     character name in it. Such as chrono.dynodns.net, 
                     the 'chrono' will get matched to a 'chrono' character. 
                     Need to come up with a fix for this. 
             )
            theHost @ "." split pop 
            dup if "*" swap strcat match else pop #-1 then
            dup player? if tempObj ! 1 isVHost ! WebDir tempDir ! 
            else pop then
        then
    then
    ( Prevent player roots if disabled )
    allowPlayer @ not tempObj @ player? and if #-1 tempObj ! then
    
    allowPlayer @ isVhost @ not and if ( no root found yet, check players )
        theDest @ 1 strcut swap pop ( remove leading / mark )
        1 strcut swap PlayerToken strcmp not if ( starts with PlayerToken )
            "/" split pop ( isolate first level to see if is player )
            "*" swap strcat match dup player? if ( valid player root )
                tempObj ! WebDir tempDir ! (players can only use default dir )
                theDest @ 1 strcut "/" swap pop strcat theDest !
            else ( doesn't match player, don't change tempObj )
                pop 
            then
        else pop
        then
    then 
    
    ( If neither vhost nor player redirection found. Use webroot )
    tempObj @ #-1 dbcmp isVHost @ not and if 
        webroot tempObj ! WebDir tempDir !
    then
    ( Necessary to remove extra leading / marks in theDest )
    begin theDest @ 
        1 strcut swap pop dup 1 strcut pop 
        "/" strcmp not if theDest ! else pop break then
    repeat
    tempObj @ tempDir @ theDest @
;
 
: handle-CGI[ ref:theProg sock:theSock dict:sockInfo str:CGIParams -- ]
  (* Handles the queueing and follow up of MUF CGI programs. 
   * First the string argument is prepared to look like the in-server
   *    webserver arguments.
   * Then the program is queued.
   * Then the sockInfo array is sent to the new prog as an optional event. 
   * The called MUF may or may not catch the event. 
   * POST form data is included in the sockInfo array under "POSTDATA", so 
         all POST CGI MUFs should catch the sockInfo array. 
   * Then this instance uses WATCHPID to sleep until the queued program ends.
   * This instance resumes and goes to close-connection. )
  var newPID
  var curSID
    sockInfo @ "SID" array_getitem curSID !
    logging @ if 
        "SID: " curSID @ strcat " called " strcat 
        theProg @ unparseobj strcat 1 do-log
    then
    theProg @ program? not if
        "500" theSock @ sockInfo @ 
        "The URL points to a non-MUF object: " theProg @ dtos strcat
        send-errormesg exit
    then
    theProg @ "LINK_OK" flag? not if
        "403" theSock @ sockInfo @ 
        "That program is not LINK_OK: " theProg @ dtos strcat
        send-errormesg exit
    then
    sockInfo @ "SID" array_getitem curSID ! 
    theProg @ "_type" getpropstr strip dup 
    if
        dup "html" instring not if ( make sure no META tag is sent later )
            "no" sockInfo @ "meta" array_setitem sockInfo !
        then
    else
        pop "text/html"
    then
    
    theProg @ 0 compile not if ( program can't be compiled )
        "500" theSock @ sockInfo @ 
        "The program cannot be compiled: " theProg @ dtos strcat
        send-errormesg exit
    then
    make-header-nolen theSock @ send-list not if
        logging @ if
            "SID: " curSID @ strcat
             "Connection closed while sending header." strcat 0 do-log
        then
        theSock @ sockInfo @ close-connection exit
    then 
    theProg @ "~web/callcount" getpropval ++ ( up program's counter )
    theProg @ swap "~web/callcount" swap setprop 
    ( make CGI header )
    theSock @ sockdescr intostr "|" strcat
    sockInfo @ "hostname" array_getitem strcat "|" strcat
    sockInfo @ "username" array_getitem strcat "|" strcat
    CGIParams @ strcat
    systime swap ( left on the stack for comparison after the program's done )
    0 swap theProg @ swap queue dup not if pop
        "500" theSock @ sockInfo @ 
        "The server timequeue is too full to call the program: " theProg @ dtos
        send-errormesg exit     
    then
    
    newPID ! ( pid is the PID of the new program )
    0 sleep  ( Necessary so that the newly queued program will exist )
    newPID @ "SOCKINFO" sockInfo @ event_send ( send event to new prog )
    newPID @ watchpid
    { "PROC.EXIT." newPID @ intostr strcat "USER.SHUTDOWN" }list
    event_waitfor "SHUTDOWN" instr if pop ( shutdown event recieved )
        newPID @ kill pop
        logging @ if 
            "SID: " curSID @ strcat "killed early by server." strcat 0 do-log
        then
        pid kill
    else -1 = if ( MUF ended by aborting. Print server-side message )
        ">" stell  (to close prior tags)
        "500" theSock @ sockInfo @ 
        "The MUF Program failed to complete properly: " 
        theProg @ ".debug/lasterr" getpropstr strcat send-errormesg exit
    then
    then
    theProg @ ".debug/lastcrash" getpropval <= if ( new crash )
        theProg @ ".debug/crashpid" getpropval newPID @ = if ( from this call )
            ">" stell 
            "500" theSock @ sockInfo @ 
            "The MUF program failed to complete properly: " 
            theProg @ ".debug/lasterr" getpropstr strcat send-errormesg exit
        then 
    then
    theSock @ sockInfo @ close-connection 
;

: handle-redirection[ sock:theSock dict:sockInfo str:theURL -- ]
  (* Handles URL relocation. 
   *     E.g.: _/www/altmain:http://akariland.dyndns.org/ 
   *     Would cause it so that the URL: http://<server>:<port>/altmain
   *     gets redirected to the address in the _/www/altmain prop. )

    redirection @ not if
        "403" theSock @ sockInfo @
        "URL redirection is not currently enabled." send-errormesg exit
    then
    theURL @ "http://" instring not if ( must be full URLs to work )
        "500" theSock @ sockInfo @
        "The URL for redirection must be a complete URL." 
        send-errormesg exit
    then
    
    { ( build redirection header )
        "HTTP/" verNum @ strcat " " strcat "302 Found\n" strcat
        "Location: " theURL @ strcat "\n" strcat
        "Content-type: text/html\n"
        "\n"
        "<HTML><HEAD><TITLE>302 Found</TITLE></HEAD>"
        "<H1>302 Found</H1>" 
        "Your browser doesn't seem to support redirection.<br>" 
        "Try clicking <A HREF=\"" theURL @ strcat
        "\">HERE</A></HTML>" strcat
    }list 
    1 sleep ( delay needed for some browsers to work right )
    theSock @ send-list not if
        logging @ if "SID: " sockInfo @ "SID" array_getitem
            "Connection lost - sending header." strcat 0 do-log
        then exit
    then
    theSock @ sockInfo @ close-connection
;

$ifdef HAVE_FILE_PRIMS
: handle-fileSending[ sock:theSock dict:sockInfo str:theDest -- ]
  (* Our binary-pass through function. No size cap yet, will implement
   * a settable cap. )
    var filePath var fileType
    ServerDir theDest @ strcat filePath !
    sockInfo @ "SID" array_getitem var! curSID
    theDest @ "." split swap pop dup if ( we have an extention )
        mimeTypes @ swap array_getitem dup if ( we have a match )
        else pop 
$ifdef defaultText
            "text/plain"
$else
            "application/octet-stream" ( no match )
$endif
        then
    else pop 
$ifdef defaultText
        "text/plain"
$else
        "application/octet-stream" ( no extention )
$endif
    then ( type ) dup fileType !
    filePath @ fsize 
    maxFileSize @ if ( there is a limit set, check against it )
        dup maxFileSize @ > if ( too big )
            "413" theSock @ sockInfo @ 
            "The file you have requested is too big: " swap intostr strcat
            " bytes" strcat
            send-errormesg exit
        then
    then intostr ( type length )
    filePath @ fstats pop -5 rotate 4 popn ( type length last-modified )
    pop pop make-header-nolen theSock @ send-list not if
        logging @ if 
            "SID: " curSID @ strcat " timed out sending header." strcat 1 do-log
        then
        theSock @ sockInfo @ close-connection exit
    then
    ( everything's good, send file )
    var counter ( to flush the descr every 1000 sends )
    fileType @ "text" instring if
        (* Use file sending for text files. Faster. *)
        var curOffset 0 array_make var! textFile
        begin
            filePath @ curOffset @ "\r" freadto swap 
            curOffset !
            dup if 
                textFile @ array_appenditem textFile !
            else pop break
            then
        repeat  
        textFile @ foreach swap pop
            theDescr @ descr? not if pop break then
            theDescr @ swap notify_descriptor
            counter ++ counter @ 200 >= if
                0 counter ! theDescr @ descrflush 1 sleep
            then
        repeat
        2 sleep
    else
        (*File sending for non-text files*)
        ( send_binary is a prim that's still experimental and buggy )
$ifdef HAVE_SEND_BINARY
        begin
            theDescr @ descr? not if break then
            theDescr @ filePath @ curOffset @ blocksize send_binary
            curOffset ! 1 < if break then
        repeat 
$else
        0 begin
            filePath @ over bread dup -1 > if ( valid byte )
                theDescr @ dup descr? not if pop pop pop break then
                swap notify_descriptor_char ++
            else pop pop break
            then
            counter ++ counter @ 1000 > 
            if theDescr @ descrflush 0 counter ! then
        repeat
$endif
    then
    theDescr @ dup descr? if (update bandwidth data)
        getdescrinfo "output_len" array_getitem 
        bytesOut @ + bytesOut !
    else pop
    then
    (* TODO:  think I can remove all this delay code and just send
     * the meta:no tag to the close-connection function. Research later. )
    var counter var lastCount 
    begin ( delay loop to make sure all data is sent first )
        theDescr @ descr? not if break then
        theDescr @ getdescrinfo "OUTPUTQUEUE" array_getitem 
        dup not if pop break then ( queue empty, safe to close connection )
        dup lastCount @ = if pop
            counter ++ 
        else 
            0 counter !
            lastCount !
        then
        counter @ 1000 > if break then ( end the infinite loop )
        0 sleep
    repeat    

    theSock @ 1 sockshutdown pop 
    2 sleep 0 counter ! 
    begin 
        theSock @ nbsockrecv pop dup not swap -1 = or if break then
        2 sleep
        counter ++ counter @ 30 > if break then
    repeat    
    theDescr @ dup descr? if descrboot 0 sleep
    else pop
    then ( close now to stop further writing )
    theSock @ sockInfo @ close-connection
;

: size2Str[ int:size -- str:sizeStr ]
  (* Given the size in bytes, returns it in short string formats *)
    size @ 1073741824 / dup if ( Gbyte ) intostr "." strcat 
        size @ 1073741824 % intostr 1 strcut pop strcat 
        "G" strcat exit
    else pop
    then
    size @ 1048576 / dup if ( Mbyte ) intostr "." strcat
        size @ 1048576 % intostr 1 strcut pop strcat 
        "M" strcat exit
    else pop
    then
    size @ 1024 / dup if ( Kbyte ) intostr "." strcat
        size @ 1024 % intostr 1 strcut pop strcat
        "K" strcat exit
    else pop
    then
    size @ (bytes) intostr "B" strcat          
;

$def nameCol 45
: print-index[ sock:theSock dict:sockInfo str:theDest arr:index -- ]
  (* Prints out a traditional directory index )
  var curFile
    begin 
        theDest @ dup strlen
        dup 1 < if pop pop break then
        1 - strcut swap pop "/" strcmp not while
        theDest @ dup strlen 1 - strcut pop theDest !
    repeat
    sockInfo @ "SID" array_getitem var! curSID
    "text/html" make-header-nolen theSock @ send-list not if 
       logging @ if  "SID: " curSID @ strcat
           "Connection lost - sending header." strcat 0 do-log
        then exit
   then
   { "<HTML><HEAD><TITLE>Index of " 
     theDest @ strcat "/" strcat "</TITLE></HEAD><BODY>" strcat
     "<H1>Index of " theDest @ strcat "/" strcat "</H1>" strcat
     "<PRE>   Name"
     "                                           " nameCol 5 - strcut pop strcat
     "Last Modified        Size" strcat
     "<HR>"
     index @ foreach swap pop curFile !     ( file prims error on spaces )
         curFile @ ".." instr curFile @ " " instr or if continue then
         "<LI><a href=\"" theDest @ "/" strcat curFile @ strcat ENCODEURL 
         strcat "\">" strcat 
         curFile @ dup strlen nameCol > if 
             nameCol 3 - strcut pop "..&gt;" strcat 
         then 
         dup strlen nameCol swap - ( this is the size of space we need )
         "                                             " swap strcut pop
         swap "</a>" strcat swap strcat strcat ( name column should be done now)
         curFile @ dup strlen 1 - strcut swap pop 
         "/" strcmp not if continue then ( don't do date/size for directories )
         ServerDir theDest @ "/" strcat curFile @ strcat strcat 
         fstats pop -5 rotate 4 popn
         "%d-%b-%Y %H:%M" swap timefmt strcat "   " strcat
         serverDir theDest @ "/" strcat 
         curFile @ strcat strcat fsize size2Str strcat
     repeat
     "<HR>"
     "<i>ProtoHTTPd/" pHTTPdVer strcat " Server at " strcat
     "servername" sysparm strcat " Port " strcat 
     prog "@web/webport" getprop intostr strcat "</i>" strcat
     "</BODY></HTML>"
   }list theSock @ send-list not if
       logging @ if  "SID: " curSID @ strcat
           "Connection lost - sending index." strcat 0 do-log
        then exit
    then
    theSock @ sockInfo @ close-connection
;

$endif ( HAVE_FILE_PRIMS ) 
 
: handle-get[ str:theDest arr:sockInfo sock:theSock -- ]
  (* Main function for parsing and answering the GET method. 
   * theDest  = part after the URL, e.g.: /index.html
   * sockInfo = dict that contains headerData, header Fields, host info, etc.
   * theSock  = the actual inbound MUF socket 
   * Order of search: 1. Look for matching proplists on theObj
                      2. Look for matching props for MUF or redirection on obj
                      3. Look for matching files on the server-side.
                      4. No match, file not found.
   ) 
  var rootObj  ( contains the dbref to search on, or #-1 )
  var rootDir  ( contains the directory that should be searched )
  var CGIParams ( contains CGI parms if any )
  var curSID  ( used for the session-ID )
  var curDir  ( used in directory/ type URLs )
  var curHome ( used for directory/ checks )
  var theProg ( used for MUF cgi calls )
    sockInfo @ "SID" array_getitem curSID !
    theDest @ "?" split CGIParams ! theDest !
    CGIParams @ sockInfo @ "CGIParams" array_setitem sockInfo !
    sockInfo @ "headerData" array_getitem "host" array_getitem
    theDest @ parsecgi theDest ! ( lib-cgi call to correct CGI )
    theDest @ get-rootObj theDest ! rootDir ! rootObj !

    ( Our root object and directory are known. Search for the file. )
    rootObj @ ok? if 
        theDest @ dup strlen 1 - strcut swap pop 
        "/" strcmp not if ( special handling for URLs ending in "/" )
            defaultHomes @ foreach swap pop curHome !
                rootDir @ ( "_/www" )
                theDest @ dup "/" strcmp not if pop "" then ( "_/www/subdir" )
                strcat 
                dup dup strlen 1 - strcut "/" strcmp not if
                    swap pop else pop ( remove trailing / mark if any )
                then
                curHome @ strcat ( "_/www/subdir/curHome " )
                curDir !
                rootObj @ curDir @ "#/" strcat propdir? if
                    rootObj @ curDir @ "/type" strcat getpropstr 
                    dup not if pop "text/html" then
                    make-header-nolen theSock @ send-list not if
                        logging @ if "SID: " curSID @ strcat
                            "Connection lost - sending header." strcat 0 do-log
                        then
                        theSock @ sockInfo @ close-connection exit
                    then
                    rootObj @ curDir @ array_get_proplist 
                    theSock @ send-list not if
                        logging @ if "SID: " curSID @ strcat
                            "Connection lost - sending list." strcat 0 do-log
                        then
                    then
                    theSock @ sockInfo @ close-connection exit
                then
            repeat ( Not found as a default proplist if it gets past here )
        else 
            ( Normal lsedit list check )
            rootObj @ rootDir @ theDest @ strcat "#/" strcat propdir? if
                rootObj @ rootDir @ theDest @ strcat "/type" strcat getpropstr
                dup not if pop "text/html" then 
                make-header-nolen theSock @ send-list not if
                    logging @ if "SID: " curSID @ strcat
                        "Connection lost - sending header." strcat 0 do-log
                    then
                    theSock @ sockInfo @ close-connection exit
                then
                rootObj @ rootDir @ theDest @ strcat array_get_proplist
                theSock @ send-list not if
                    logging @ if "SID: " curSID @ strcat
                        "Connection lost while sending list." strcat 0 do-log
                    then
                then
                theSock @ sockInfo @ close-connection exit
            then
        then
        ( If we got to here, then it isn't an lsedit web page )
        ( Now check for MUF props )
        ( MUF programs must be LINK_OK to be called by the webserver )
        rootObj @ player? playerCGI @ and rootObj @ player? not or if 
            theDest @ dup strlen 1 - strcut swap pop 
            "/" strcmp not if ( special handling for URLs ending with '/' )
                defaultHomes @ foreach swap pop curHome !
                    rootObj @ rootDir @ 
                    theDest @ dup "/" strcmp not if pop "" then 
                    strcat 
                    dup dup strlen 1 - strcut "/" strcmp not if
                        swap pop else pop ( remove trailing / mark if any )
                    then
                    curHome @ strcat getprop dup if
                        dup dbref? if theProg !
                            theProg @ theSock @ sockInfo @ CGIParams @
                            handle-CGI exit
                        else (possibly string for redirection)
                            dup string? if theSock @ swap sockInfo @ swap 
                                handle-redirection exit
                            else pop
                            then
                        then    
                    else pop
                    then
                repeat
            else ( theDest doesn't end with '/' )
                rootObj @ rootDir @ theDest @ strcat getprop if
                    rootObj @ rootDir @ theDest @ strcat getprop
                    dup dbref? if theProg !
                        theProg @ theSock @ sockInfo @ CGIParams @ 
                        handle-CGI exit
                    else ( possible redirection )
                        dup string? if theSock @ swap sockInfo @ swap
                            handle-redirection exit
                        else pop
                        then
                    then
                then ( No error here, the prop didn't contain anything )
            then ( end of MUF prop checks )
        then ( end of checking MUF props or not )
     then  ( not an okay root object )

    ( A lot of stuff past here is dependent on file prims, check the $def )
$ifdef HAVE_FILE_PRIMS
    ( Nothing found in-server. Check serverside for the file              )
    allowBinary @ theDest @ " " instr not and if 
        theDest @ ".." instr if ( can't allow directory redirection )
            "403" theSock @ sockInfo @
            "The webserver does not have permission for that directory."
            send-errormesg exit
        then 
        theDest @ dup strlen 1 - strcut swap pop 
        "/" strcmp not if ( special handling for URLs ending with '/' )
            defaultHomes @ foreach swap pop curHome !
                curHome @ not if continue then
                ServerDir theDest @ dup "/" strcmp not if pop "" then         
                dup dup strlen 1 - dup 0 > if
                    strcut "/" strcmp not if
                        swap pop else pop ( removing trailing / mark if any )
                    then 
                else
                    pop pop
                then
                curHome @ strcat dup var! tempLoc strcat
                fsize 0 > if 
                    theSock @ sockInfo @ tempLoc @ handle-fileSending exit
                then
            repeat ( no default home found )
        then ( end of special handling. Now look for directory )        
        ServerDir theDest @ strcat getdir dup array? if 
            theSock @ swap sockInfo @ swap theDest @ swap print-index exit
        else pop
        then 
        ServerDir theDest @ strcat fsize 0 > if ( file found )
            theSock @ sockInfo @ theDest @ handle-fileSending exit
        then
    then
$endif
    "404" theSock @ sockInfo @ 
    "The file you are looking for was not found: " theDest @ strcat
    send-errormesg    
;

: catch-POSTdata[ str:length sock:theSock -- arr:data int:status ]
  (* Using the 'length' parameter from the request header, 
   * attempts to read in from the socket stream until the
   * that amount of data is recieved. If the socket times
   * out without recieving the full content length, it is
   * assumed that the POST data didn't send completely. )
  var curLength ( keeps track of how much data read in so far )
  0 array_make var! data ( the strings read in so far. )
  
    begin curLength @ length @ < while
        theSock @ sockread-line dup not if data @ 0 exit then ( timed out )
        dup strlen curLength @ + curLength ! 
        data @ array_count not if ( strip leading \n marks from first line )
            dup "\n" strcmp not over "\r" strcmp not or if pop continue then
        then
        data @ array_appenditem data !
    repeat
    data @ 1    
;

: handle-post[ str:theDest arr:sockInfo sock:theSock -- ]
  (* Handles the POST method. Only looks for a valid MUF program
   * to pass the POST data on to. )
  var rootObj ( containes the dbref to search for the prop on. )
  var rootDir ( containes the directory that should be searched. )
  var CGIParams ( contains CGI parms if any. )
  var curSID   ( used for the session-ID )
  var curDir  ( Used in directory/ type URLs )
  var curHome ( used for directory/ checks for default homes. )
  var theProg ( used for MUF CGI calls. )
  var postData ( holds the POST related data. )

    sockInfo @ "SID" array_getitem curSID !
    theDest @ "?" split CGIParams ! theDest !
    CGIParams @ sockInfo @ "CGIParams" array_setitem sockInfo !
    sockInfo @ "headerData" array_getitem "host" array_getitem
    theDest @ parsecgi theDest ! 
    theDest @ get-rootObj theDest ! rootDir ! rootObj !

    rootObj @ #-1 dbcmp if
        "500" theSock @ sockInfo @
        "The webroot for this URL is not valid for POST forms." 
        send-errormesg exit
    then
    
    sockInfo @ "headerData" array_getitem "Content-Length" array_getitem
    dup number? not if pop
        "400" theSock @ sockInfo @
        "POST method requests require a Content-Length field." 
        send-errormesg exit
    else atoi
    then
    theSock @ catch-POSTdata not if 
        logging @ if "SID: " curSID @ strcat
           "Timed out while reading POST data." strcat 0 do-log
        then
        "408" theSock @ sockInfo @ 
        "Operation timed out while reading in POST form data." 
        send-errormesg exit
    then postData !
    postData @ parse-postCGI postData ! ( lib-CGI call )
    ( post data is now a dictionary in the form of:
        <field-name>:<fieldcontents in string array> )
    postData @ sockInfo @ "POSTDATA" array_setitem sockInfo ! (add to sock info)  
    rootObj @ player? playerCGI @ and rootObj @ player? not or if 
        theDest @ dup strlen 1 - strcut swap pop 
        "/" strcmp not if ( special handling for URLs ending with '/' )
            defaultHomes @ foreach swap pop curHome !
                rootObj @ rootDir @ 
                theDest @ dup "/" strcmp not if pop "" then 
                strcat 
                dup dup strlen 1 - strcut "/" strcmp not if
                    swap pop else pop ( remove trailing / mark if any )
                then
                curHome @ strcat getprop dup if
                    dup dbref? if theProg !
                        theProg @ theSock @ sockInfo @ CGIParams @
                        handle-CGI exit
                    else pop
                    then
                else pop
                then
            repeat
        else ( theDest doesn't end with '/' )
            rootObj @ rootDir @ theDest @ strcat getprop if
                rootObj @ rootDir @ theDest @ strcat getprop
                dup dbref? if theProg !
                    theProg @ theSock @ sockInfo @ CGIParams @ 
                    handle-CGI exit
                else pop
                then
            then ( No error here, the prop didn't contain anything )
        then ( end of MUF prop checks )
    then ( end of checking MUF props or not )
    "404" theSock @ sockInfo @ 
    "The file could not be found: " theDest @ strcat 
    send-errormesg
;

: get-header[ sock:theSock -- dict:headerMap arr:headerFields int:success ]
  (* Handles reading the header in and storing it into arrays.            *)
    0 array_make_dict var! headerData ( the header data map )
    0 array_make var! headerFields    ( header fields in order recieved )
    var newlines ( 2 consectutive line breaks means end of header )
    begin
        theSock @ sockread-line 
        dup not if headerData @ headerFields @ 0 exit then
        dup "\r" strcmp not if pop (new line) 
            newlines ++ 
            newlines @ 1 > if (2 newlines, end of header )
                headerData @ headerFields @ 1 exit
            then
        else ( field line ) 0 newlines ! 
            ":" split strip swap strip swap  ( field data )
            over headerFields @ array_appenditem headerFields !
            headerData @ rot array_setitem headerData !
        then
    repeat
;

: handle-unsupported[ str:theDest dict:sockInfo sock:theSock -- ]
  (* Default handler for specifically unsupported functions *)
      "405" theSock @ sockInfo @
      "That method is not allowed by this server." send-errormesg
;
 
$def add-count prog over getpropval ++ prog swap rot swap setprop
: analyse-connection[ dict:sockInfo -- ]
  var curPos        var curHost
  var hostCache     var clearedHost
    (* This function records the various stats for reporting. *)
    keepStats @ not if exit then ( don't record stats )
    prog "@web/lastcon" systime setprop ( time of last connection )
    prog "@web/concount" getpropval ++ 
    prog swap "@web/concount" swap setprop ( connection # this run-time )
    prog "@web/tconcount" getpropval ++
    prog swap "@web/tconcount" swap setprop ( total cons ever )

    ( Update the host cache. )
    sockInfo @ "hostname" array_getitem curHost !
    prog "@web/hosts" array_get_proplist hostCache !
    prog "@web/hosts#" remove_prop ( clear the props for now )
    ( check if host is cached, if so, clear it so it can go back to the top )
    hostCache @ foreach swap curPos !
        curHost @ stringcmp not if ( already cached, clear it )
            hostCache @ curPos @ array_delitem hostCache ! 
            1 clearedHost ! break
        then
    repeat
    clearedHost @ not if ( wasn't already cached, remove oldest host )
        hostCache @ prog "@web/hostcache" getpropval dup not if pop 10 then
        -- 
        array_delitem hostCache !
    then
    hostCache @ array_reverse curHost @ swap array_appenditem array_reverse
    prog swap "@web/hosts" swap array_put_proplist
    
    ( client data -- Since clients don't follow a standard in the user-agent 
                     field format, this will be a rough  guess at best. )
    sockInfo @ "headerData" array_getitem "user-agent" array_getitem
    dup string? if
    ( browser first IE6, IE5, IE4, IE-O, Mozzila, Opera, NS O, NS 6)
        dup "MSIE" instr if 
            "MSIE" split swap pop "." split pop
            atoi dup 6 = if pop "@web/browsers/IE6" add-count
            else dup 5 = if pop "@web/browsers/IE5" add-count
            else dup 4 = if pop "@web/browsers/IE4" add-count
            else pop "@web/browsers/IEO" add-count
            then then then
        else dup "Netscape6" instring if pop "@web/browsers/NS6" add-count
        else dup "compatible" instring not over "opera" instring not and if        
            ( if not opera, and doesn't have 'compatible', it's probably NS )
            pop "@web/browsers/NSO" add-count 
        else dup "Opera" instring if pop "@web/browsers/Opera" add-count
        else dup "Lynx" instring if pop "@web/browsers/lynx" add-count
        else pop "@web/browsers/Other" add-count ( the catch all. )
        then then then then then 
    else pop
    then ( no user-agent field )
    ( again, we guess at the OS :P )
    sockInfo @ "headerData" array_getitem "user-agent" array_getitem
    dup string? if
        dup "Win" instring over "98" instring and if pop
            "@web/OS/Win98" add-count
        else dup "Win" instring over "95" instring and if pop
            "@web/OS/Win95" add-count
        else dup "Win" instring over "NT" instring and over "5" instring and
        if pop "@web/OS/Win2k" add-count
        ( TODO: I currently have no idea on WinXP. Need to check. 
        else dup "Win" instring over "XP" instring and if pop
            "@web/OS/WinXP" add-count 
        )
        else dup "Win" instring over "NT" instring and if pop
            "@web/OS/WinNT" add-count
        else dup "Win" instring over "16" instring and if pop
            "@web/OS/Win3.1" add-count
        else dup "Mac" instring if pop
            "@web/OS/Mac" add-count
        else pop "@web/OS/other" add-count
        then then then then then then
    else pop
    then
;
 
: process-request[ sock:theSock -- ]
  (* Handles everything to do with the in-bound connection 
   * Is a child process seperate from the main daemon, so if it
   * crashes, the main daemon is unaffected. )
    var theMethod var theDest var sockInfo 
    get_sessionID var! SID
    "1.1" verNum ! ( default to 1.1, will change to 1.0 if older browser. )
    theSock @ socktodescr theDescr ! ( make it a writeable descriptor )
    logging @ if
        ">>>Web Server inbound connection accepted::Descr: %d SID: %s<<<"
        theSock @ sockdescr intostr "%d" subst SID @ "%s" subst 1 do-log
    then
    theSock @ HOMEINSTANCE set_sockopt pop 
    ( Get an info dictionary on this socket )
    theSock @ get_sockinfo SID @ swap "SID" array_setitem sockInfo ! 
    ( Get and parse our first line: <method> <target> <HTTP version> ) 
    serverOff @ if ( server up, but disabled )
        "503" theSock @ sockInfo @ 
        "The webserver is not currently serving files. Try back later."
        send-errormesg exit
    then
    maxInstance @ if 
        prog instances maxInstance @ > if 
            "503" theSock @ sockInfo @
            "The webserver is currently busy. Try back later." 
            send-errormesg exit
        then
    then
    theSock @ sockread-line
    dup not if "408" theSock @ sockInfo @ 
        "No valid request was sent before timeout." send-errormesg exit
    then
    "SID: " SID @ strcat " " strcat over strcat 0 do-log
    " " split " " split "/" split swap pop verNum ! theDest ! theMethod !
    theMethod @ sockInfo @ "METHOD" array_setitem sockInfo !
    theDest @ sockInfo @ "TheDEST" array_setitem sockInfo !
    ( Now get the header variables ) 
    theSock @ get-header not if ( header never finished sending, close. )
        logging @ if "SID: " SID @ strcat 
            "Timed out while reading header." 0 do-log 
        then
        "408" theSock @ sockInfo @ 
        "A valid request header was not recieved before the timeout." 
        send-errormesg exit        
    then
    ( Pack header arrays into the sockinfo dictionary )
    sockInfo @ "HeaderFields" array_setitem
    "HeaderData" array_setitem sockInfo !
    sockInfo @ analyse-connection
    ( functionMap is a dict of methods and the functions to handle them )
    functionMap @ theMethod @ array_getitem 
    dup address? if 
        theDest @ swap sockInfo @ swap theSock @ swap execute
    else pop
        "405" theSock @ sockInfo @ 
        "The webserver does not know that method: " theMethod @ strcat
        send-errormesg exit
    then
;
 
: main-loop[ sock:theLSock -- ]
  (* Main daemon loop for the webserver 
     This part is virtually uncrashable, so the webserver will always stay
     up even when client-serving instances encounter errors.
   *)
    begin
        { "SOCKET.LISTEN*" "USER.SHUTDOWN" "USER.PREFCHECK" }list 
        event_waitfor 
        dup "SHUTDOWN" instr if pop 
            "^NAVY^ProtoMUCK Webserver has been shut down." atell break
        then 
        dup "PREFCHECK" instr if pop
            "Webserver Prefs updated by " swap "data" array_getitem
            unparseobj strcat 0 do-log
            check-prefs continue 
        then
        pop pop 
        begin ( loop until no more connections found ) 
            theLSock @ sockaccept dup socket? if ( fork off an instance )
                fork not if 
                    prog "@web/lastcon" systime setprop
                    process-request exit 
                else pop (pop the socket ) 
                then 
            else pop break then
        repeat
        ( update preferences )
        check-prefs
    repeat
    prog "@web/stoptime" systime setprop
    logging @ if
        "Webserver shutdown by " swap "data" array_getitem unparseobj strcat
        "." strcat 0 do-log
    then
;
 
: init-server[ str:args -- ]
  (* Build any dictionaries needed, initialize arrays, open port *)
    prog instances 1 > if
        "^CRIMSON^There is already an instance of the webserver running for " 
        prog "@web/startTime" getprop systime swap -
        time-to-str strcat "." strcat
        atell 0 exit
    then
    "^FOREST^Initializing server..." atell
    check-prefs
    prog "@web/serverPID" PID setprop 
    prog "@web/starttime" systime setprop
    prog "@web/lastSID" remove_prop
    prog "@web/bytesOut" remove_prop
    prog "@web/concount" remove_prop
    logging @ if
        "ProtoMUCK HTTPd started by %n." me @ unparseobj "%n" subst 0 do-log
    then
    
    "^BROWN^Building needed dictionaries..." atell
    { ( mime types and their browser specification. Add new ones here. )
        "htm"       "text/html"
        "html"      "text/html"
        "txt"       "text/plain"
        "text"      "text/plain" 
        "pdf"       "application/pdf"
        "zip"       "application/zip"
        "gz"        "application/x-gzip"
        "exe"       "application/octet-stream"
        "bin"       "application/octet-stream"
        "tar"       "application/x-tar"
        "mp3"       "audio/mpeg"
        "ra"        "audio/x-realaudio"
        "wav"       "audio/x-wav" 
        "gif"       "image/gif"
        "jpg"       "image/jpeg"
        "jpeg"      "image/jpeg"
        "png"       "image/png"
        "avi"       "video/x-msvideo"
        "mpg"       "video/mpeg"
        "mpeg"      "video/mpeg"
        "muf"       "text/plain"
        "m"         "text/plain"
    }dict mimeTypes !
    
    { ( request options and their function addresses to handle them )
      "get"     'handle-get
      "post"    'handle-post
      "options" 'handle-unsupported (may be supported at a later date )
      "head"    'handle-unsupported (probably change to supported later )
      "put"     'handle-unsupported (a security risk most of the time)
      "delete"  'handle-unsupported (would allow deletion of target files )
      "trace"   'handle-unsupported (not likely to support )
      "connect" 'handle-unsupported (Involved with SSL tunneling )
    }dict functionMap !
    
    { ( Error codes and their messages. Only ones that apply included. )
        "400"  "Bad Request" 
        "403"  "Forbidden"
        "404"  "Not Found" 
        "405"  "Method Not Allowed" 
        "408"  "Request Timeout" 
        "413"  "Request Entity Too Large" 
        "416"  "Requested Range Not Satisfiable" 
        "500"  "Internal Server Error" 
        "501"  "Not Implemented" 
        "503"  "Service Unavailable" 
    }dict errorMesgs !
    
    { ( list of default locations to look for, in order of priority )
      "/index.html"
      "/index.htm"
      "/home.html"
      "/home.htm"
      "/index"
      "/home"
      ""  ( will look at _/www#/ )
    }list defaultHomes !
    -1 var! webPort ( An integer representing the listening port )
    prog "@web/webport" getprop dup not 
    args @ "port" instring or if pop
        "^FOREST^Enter the webserver port: " atell 
        read dup number? if
            atoi webPort !
            prog "@web/webport" webPort @ setprop
        else pop
        then
    else webPort !
    then
    webPort @ dup 1 < over 65535 > or if 
        "^BROWN^Invalid web port: ^YELLOW^" webPort @ intostr strcat atell 
        0 exit
    else pop
    then
    "^BROWN^Opening listening port..." atell
    port_queue webPort @ lsockopen dup "noerr" stringcmp if ( error )
        swap pop
        "^CRIMSON^Unable to open listening port: ^RED^" swap strcat dup atell
        logging @ if 0 do-log else pop then
        0 exit
    else pop then
    "^FOREST^Webserver running on port %port. Use '" command @ strcat 
    " stop' when you want to shut it down." strcat 
    WebPort @ intostr "%port" subst atell
    prog owner me ! ( future messages go to the owner only )
    logging @ if "Initialization finished, entering main loop." 0 do-log then
;
 
: do-shutdown ( -- ) 
    prog instances 2 < if 
        "^YELLOW^The webserver is not currently up." atell exit 
    then
    "^BROWN^The webserver has been running for " 
    prog "@web/startTime" getprop systime swap - 
    time-to-str strcat "." strcat atell
    "^FOREST^Are you sure you want to shut down the webserver?(y/N)" atell
    read "y" stringpfx not if "^BLUE^Cancelled." atell exit then
    "^BLUE^Shutting down the webserver..." atell 
    prog getpids foreach swap pop
        dup pid = if pop continue then
        "SHUTDOWN" me @ event_send
    repeat
;

(** Stats printouts, help screens, config menus. **)
$def fetch prog swap getpropval ( lazy programmer's $def )
$def NUMCOL 9 ( width of the number columns )

: do-stats ( -- )
  (* Print out various usage stats on the webserver *)
  var isUp ( bool to indicate if server is running or not )
    prog "@web/serverPID" getpropval ispid? isUp !
    
    "^WHITE^ProtoHTTPd Webserver " pHTTPdVer strcat
    " by Akari and Nodaitsu" strcat atell
    "^BLUE^------------------------------------------------------------------------------" 
    atell
    isUp @ if ( server running )
        "^FOREST^Started: ^GREEN^%a %b %e, %Y ^FOREST^at ^GREEN^%r" 
        "@web/starttime" fetch timefmt atell
        "^FOREST^Uptime: ^GREEN^" 
        systime "@web/starttime" fetch - time-to-str strcat atell
    else
        "^BROWN^Shutdown: ^YELLOW^%a %b %e, %Y ^BROWN^at ^YELLOW^%r"
        "@web/stoptime" fetch timefmt atell
        "^BROWN^Downtime: ^YELLOW^" 
        systime "@web/stoptime" fetch - time-to-str strcat atell
    then
    "^VIOLET^Last Connection: ^PURPLE^%a %b %e, %Y ^VIOLET^at ^PURPLE^%r"
    "@web/lastcon" fetch timefmt atell
    "^VIOLET^Served ^PURPLE^" "@web/bytesOut" fetch 1000 / 
    dup 100000 < if 
        intostr " Kbytes" 
    else
        1000 / intostr " Mbytes" 
    then strcat strcat
    " ^VIOLET^over ^PURPLE^" "@web/concount" fetch intostr strcat strcat
    " ^VIOLET^connections" strcat atell
    "^VIOLET^Total Connections Ever: ^PURPLE^" 
    "@web/tconcount" fetch intostr strcat atell
    ( Print out operating systems detected )
    "^CYAN^Operating Systems Detected: " atell
    "  ^AQUA^Windows 3.1^CRIMSON^: ^BROWN^" 
    "@web/OS/Win3.1" fetch intostr NUMCOL strRight strcat 
    "   ^AQUA^Windows NT^CRIMSON^: ^BROWN^"
    "@web/OS/WinNT" fetch intostr NUMCOL strRight strcat strcat
    "   ^AQUA^Macintosh^CRIMSON^: ^BROWN^"
    "@web/OS/Mac" fetch intostr NUMCOL strRight strcat strcat atell
    "  ^AQUA^Windows 95 ^CRIMSON^: ^BROWN^"
    "@web/OS/Win95" fetch intostr NUMCOL strRight strcat
    "   ^AQUA^Windows 2K^CRIMSON^: ^BROWN^"
    "@web/OS/Win2K" fetch intostr NUMCOL strRight strcat strcat
    "   ^AQUA^Other    ^CRIMSON^: ^BROWN^"
    "@web/OS/other" fetch intostr NUMCOL strRight strcat strcat atell
    "  ^AQUA^Windows 98 ^CRIMSON^: ^BROWN^"
    "@web/OS/Win98" fetch intostr NUMCOL strRight strcat 
    "   ^AQUA^Windows XP^CRIMSON^: ^BROWN^" 
    "@web/OS/WinXP" fetch intostr NUMCOL strRight strcat strcat atell
    ( Print out Browsers Detected )
    "^CYAN^Browsers Detected: " atell
    "  ^AQUA^Internet Explorer 6    ^CRIMSON^: ^BROWN^" 
    "@web/Browsers/IE6" fetch intostr NUMCOL strRight strcat
    "   ^AQUA^Netscape 6    ^CRIMSON^: ^BROWN^"
    "@web/Browsers/NS6" fetch intostr NUMCOL strRight strcat strcat
    "   ^AQUA^Other^CRIMSON^: ^BROWN^" 
    "@web/Browsers/other" fetch intostr NUMCOL strRight strcat strcat atell
    "  ^AQUA^Internet Explorer 5    ^CRIMSON^: ^BROWN^"
    "@web/Browsers/IE5" fetch intostr NUMCOL strRight strcat
    "   ^AQUA^Netscape Other^CRIMSON^: ^BROWN^"
    "@web/browsers/NSO" fetch intostr NUMCOL strRight strcat strcat atell
    "  ^AQUA^Internet Explorer 4    ^CRIMSON^: ^BROWN^"
    "@web/Browsers/IE4" fetch intostr NUMCOL strRight strcat
    "   ^AQUA^Opera         ^CRIMSON^: ^BROWN^"
    "@web/Browsers/Opera" fetch intostr NUMCOL strRight strcat strcat atell
    "  ^AQUA^Internet Explorer Other^CRIMSON^: ^BROWN^"
    "@web/Browsers/IEO" fetch intostr NUMCOL strRight strcat
    "   ^AQUA^Lynx          ^CRIMSON^: ^BROWN^"
    "@web/browsers/lynx" fetch intostr NUMCOL strRight strcat strcat atell
    "^YELLOW^Host Cache: " atell
    prog "@web/hosts" array_get_proplist foreach swap 1 + intostr
        "^GREEN^" swap strcat ") ^BROWN^" strcat swap strcat atell
    repeat
    "^YELLOW^~Done~" atell    
;

$def pref prog swap getprop if "Yes" else "No" then
: do-config ( -- )
  (* Configuration utility for setting preferences *)
  var prefProps   ( Dictionary of Preference props for Editor )
  var helpArray   ( string array of the help contents )
  { ( Build pref props dictionary for toggleable options )
    "1"  "@web/log"
    "2"  "@web/debug"
    "3"  "@web/vhosts" 
    "4"  "@web/binary"
    "5"  "@web/logwall"
    "6"  "@web/playerCGI"
    "7"  "@web/offline"
  ( "8"  "@web/maxfile" ) (not included because of special handling )
    "9"  "@web/keepstats" 
    "10" "@web/debugSend"  
  ( "11" "@web/hostcache" ) ( not included because of special handling )
  ( "12" "@web/maxInstances" ) ( not included because of special handling )
    "13" "@web/redirect" 
  }dict prefProps ! 
  
  {
    " 1 - Turns on server-side logging. Requires file prims." 
    " 2 - Turns on more detailed logging and echos messages to the owner." 
    " 3 - Allow or disallow virtual hosts. See #info1." 
    " 4 - Allow or disallow server-side file reading. Requires file prims." 
    " 5 - Toggle LOGWALLING to characters set LOGWALL." 
    " 6 - Allow players to make their own MUFCGI. Potentially very risky." 
    " 7 - Take the server offline. Port remains open, but no pages served." 
    " 8 - Max file size that can be sent from the server-side in bytes." 
    " 9 - Turn on or off the stats keeping support." 
    "10 - Echo all text sent to the client by the webserver to the owner." 
    "11 - Number of prior hosts to keep cached." 
    "12 - Max number of simultaneous instances." 
    "13 - Turns on URL redirection." 
  }list helpArray !


    begin
    "^WHITE^ProtoMUCK HTTPd Configuration Menu ^AQUA^by ^WHITE^Akari" atell
    " " .tell
    " [^YELLOW^1^NORMAL^] Logging^YELLOW^:            ^NORMAL^" 
    "@web/log" pref strcat atell
    " [^YELLOW^2^NORMAL^] Debugging^YELLOW^:          ^NORMAL^" 
    "@web/debug" pref strcat atell
    " [^YELLOW^3^NORMAL^] Virtual hosts^YELLOW^:      ^NORMAL^" 
    "@web/vhosts" pref strcat atell
    " [^YELLOW^4^NORMAL^] File transfers^YELLOW^:     ^NORMAL^" 
    "@web/binary" pref strcat atell
    " [^YELLOW^5^NORMAL^] Do LogWall^YELLOW^:         ^NORMAL^" 
    "@web/logwall" pref strcat atell            
    " [^YELLOW^5^NORMAL^] Player Pages^YELLOW^:       ^NORMAL^" 
    "@web/players" pref strcat atell        
    " [^YELLOW^6^NORMAL^] Player MUF^YELLOW^:         ^NORMAL^" 
    "@web/playerCGI" pref strcat atell
    " [^YELLOW^7^NORMAL^] Server Offline^YELLOW^:     ^NORMAL^" 
    "@web/offline" pref strcat atell
    prog "@web/maxfile" getprop 
    dup if intostr " bytes" strcat else pop "None" then
    " [^YELLOW^8^NORMAL^] MaxFileSize (byte)^YELLOW^: ^NORMAL^" 
    swap strcat atell
    " [^YELLOW^9^NORMAL^] Record Stats^YELLOW^:       ^NORMAL^" "@web/keepstats" 
    pref strcat atell   
    "[^YELLOW^10^NORMAL^] Debug Send^YELLOW^:         ^NORMAL^" "@web/debugsend" 
    pref strcat atell 
    prog "@web/hostcache" getprop dup if intostr else pop "10" then
    "[^YELLOW^11^NORMAL^] Host cache^YELLOW^:         ^NORMAL^" 
    swap strcat atell
    prog "@web/maxInstances" getprop dup if intostr else pop "Not Set" then
    "[^YELLOW^12^NORMAL^] Max Instances^YELLOW^:      ^NORMAL^" 
    swap strcat atell
    "[^YELLOW^13^NORMAL^] URL Redirection^YELLOW^:    ^NORMAL^"
    "@web/redirect" pref strcat atell
    " " .tell
    "^GREEN^[^YELLOW^H^GREEN^]elp" atell
    "^BLUE^[^YELLOW^Q^BLUE^]uit" atell      
    read strip prefProps @ over array_getitem dup if ( toggleable option )
        prog over getprop if ( need to clear )
            prog swap remove_prop
            "^YELLOW^Option disabled." atell 
        else ( need to set )
            prog swap "yes" setprop
            "^GREEN^Option enabled." atell
        then continue
    else pop 
    then 
    ( non-toggleable options )
    dup "8" strcmp not if pop ( set max file size )
        "^FOREST^Enter max file size in bytes or 0 to clear: " atell
        read dup number? not if pop continue then
        atoi prog swap "@web/maxfile" swap setprop
        "^GREEN^Max File Size set." atell continue
    then
    dup "11" strcmp not if pop ( set host cache size )
        "^FOREST^Enter number of host addresses to cache: " atell
        read dup number? not if pop continue then
        atoi prog swap "@web/hostcache" swap setprop
        "^GREEN^Host Cache size set." atell continue
    then
    dup "12" strcmp not if pop ( set max instances )
        "^FOREST^Enter max number of clints to serve at once: " atell
        read dup number? not if pop continue then
        atoi prog swap "@web/maxInstances" swap setprop
        "^GREEN^Max number of instances set." atell continue
    then
    dup "h" stringcmp not if pop ( print help )
        helpArray @ me @ 1 array_make array_notify 
        read_wants_blanks ( turn on blank input catching )
        "^AQUA^Press enter to continue." atell
        read pop
        read_wants_blanks ( turn off blank input catching )
        continue
    then
    dup "q" stringcmp not if pop ( quit editor )
        "^BLUE^Updating Preferences in webserver..." atell
        prog "@web/serverPID" getprop "PREFCHECK" me @ event_send
        "^BLUE^Preferences updated." atell exit
    then
    pop "^RED^Invalid option." atell continue
    repeat           
;

: do-credits ( -- )
  (* Just a simple credits printout. *)
  "^WHITE^ProtoMUCK HTTPd/" pHTTPdver strcat 
  " ^NORMAL^running on ^WHITE^" strcat version strcat atell
  "^BLUE^------------------------------------------------------------------------------" 
  atell    
  "  This MUF only webserver was concieved by Akari and Nodaitsu during the" .tell
  "  early days of ProtoMUCK's development. Now, after weeks of work on the" .tell
  "  MUF Socket support in Protomuck, the MUF code itself, and endless hours" .tell
  "  of testing, a new world of options have become available through this" .tell
  "  latest development in MUF-based web projects."  .tell
  " " .tell
  "  ProtoMUCK HTTPd was written by Akari and Nodaitsu" .tell
  " " .tell
  "  Special thanks are due to: " .tell
  "    Kaeru - For providing the machine it was developed on." .tell
  "    Rika  - For the endless tests we ran to debug it." .tell
  "    Everyone else that helped with testing or suggestions. ^_^" .tell
  " " .tell
  "  The latest version of the ProtoHTTPd server can always be found at: " .tell
  "      http://sourceforge.net/projects/protomuck" .tell
  "  Please submit bug reports to: " .tell
  "      http://sourceforge.net/tracker/?atid=107012&group_id=7012&func=browse" .tell
  "^YELLOW^~Done~" atell 
;
 
: do-help ( -- )
 (* Simple help printout. *)
  "^WHITE^ProtoMUCK HTTPd/" pHTTPdver strcat 
  " ^NORMAL^by ^WHITE^Akari ^NORMAL^and ^WHITE^Nodaitsu" strcat atell
  "^BLUE^------------------------------------------------------------------------------" 
  atell  
  " Once started, the webserver should become a quiet background process" .tell
  " that runs until the MUCK is shutdown or the webserver is stopped. It" .tell
  " can be set AUTOSTART to make it startup when the MUCK is started."  .tell
  " " .tell 
  "  " command @ strcat " start      - Start the webserver on default port."
  strcat .tell 
  "  " command @ strcat " start port - Start the webserver on a new port." 
  strcat .tell
  "  " command @ strcat " stop       - To shutdown the webserver."
  strcat .tell
  "  " command @ strcat " #config    - Configure webserver options." 
  strcat .tell
  "  " command @ strcat " #stats     - To view webserver usage stats." 
  strcat .tell
  "  " command @ strcat " #info1     - Advanced use notes." strcat .tell
  "  " command @ strcat " #info2     - More advanced use notes." strcat .tell
  "  " command @ strcat " #credits   - Credits and helpful URLs." strcat .tell
  "^YELLOW^~Done~" atell
;
: do-info1 ( -- )
  (* More advanced notes *)
  "^WHITE^Advanced notes" atell
  "^BLUE^------------------------------------------------------------------------------" 
  atell    
  "To set custom error messages, set props on the program as: " .tell
  "    @web/mesgs/<code#>:<custom message>" .tell
  "  For example: " .tell
  "    @web/mesgs/404:Kaeru must have eaten that page." .tell
  "To make entirely custom error pages, set lsedit lists as: " .tell
  "    @web/pages/<code>" .tell
  "  For example: " .tell
  "    lsedit " prog dtos strcat "=@web/pages/404 - To make a custom 404 page." 
  strcat .tell
  "To add virtual hosts, simply add the complete host to @vhosts/ as: " .tell
  "    @vhosts/<complete URL>/rootObj:<dbref of root object>" .tell
  "    @vhosts/<complete URL>/rootDir:<root directory>" .tell
  "  For example: " .tell
  "    @vhosts/akari.frogpond.dynodns.net/rootObj:#3166" .tell
  "    @vhosts/akari.frogpond.dynodns.net/rootDir:~public_html" .tell
  "    This would make http://akari.frogpond.dynodns.net:8084/" .tell
  "    point straight to a '~public_html' directory on my character." .tell
  "  Setting the rootObj to #-1 will force the URL to search only server-side" .tell
  "    if that option is enabled." .tell
  "  Characters can also host their own pages as: " .tell
  "    http://<url>:<port>/~<character name/ " .tell
  "^YELLOW^~Done~" atell
;

: do-info2 ( -- )
 (* More advanced notes *)
  "^WHITE^Advanced notes page 2" atell
  "^BLUE^------------------------------------------------------------------------------" 
  atell    
  "MUF Programs must be set LINK_OK to be called from the webserver." .tell
  "If the MUF CGI creates data other than text/html, a _type: prop can " .tell
  "  be set on the program itself to designate what type it should be" .tell
  "  identified as. If the MUF program generates its own header, or should " .tell
  "  not have a header, the _type prop should be set as 'noheader'" .tell
  "The same can be done for LSEDIT List pages by setting a /type prop with" .tell
  "  on the end of the same name as the LSEDIT without the trailing #." .tell
  "  For example: " .tell
  "    _/www/infofile/type:text/plain" .tell
  "  would make it so that the _/www/infofile# web page would be sent as plain text." .tell
  "MUF CGI programs recieve a starting parameter of: " .tell
  "<descr>|<client's host address>|<client's username or port>|<raw CGI params>"
  .tell
  "In addition, MUF programs are always sent an event from the webserver" .tell
  "  that they can catch by watching for a USER.SOCKINFO event." .tell
  "  The data of this event contains the following information: " .tell
  "    CGIParams    - Raw GET CGI params if any." .tell
  "    HeaderData   - Dictionary array of header fields and their contents." .tell
  "    HeaderFields - List array of the header field names in order recieved." .tell
  "    Method       - Client method requested (GET, POST, etc. )" .tell
  "    POSTDATA     - If the MUF was called via the POST method, this contains" .tell
  "                   a dictionary of the POST form field names and contents." .tell
  "    SID          - Session ID Number - Number identifying the connection." .tell
  "      Plus all of the fields returned by the GET_SOCKINFO prim are present." .tell
  "^YELLOW^~Done~" atell
 
;     
: main ( s -- )
    me @ "ARCHWIZARD" flag? not if
        "^CRIMSON^Permission denied." atell exit
    then
    dup "#help" stringpfx if pop do-help exit then
    dup "#info1" stringpfx if pop do-info1 exit then
    dup "#info2" stringpfx if pop do-info2 exit then
    dup "#config" stringpfx if pop do-config exit then
    dup "credit" instring if pop do-credits exit then
    dup "stats" stringpfx over "#stats" stringpfx or if pop do-stats exit then
    dup "Startup" stringcmp not over "start" instring or if
        init-server dup socket? not if exit then
        background
        ( Everything's ready, enter the main loop )
        main-loop exit
    then
    dup "stop" instring over "shutdown" instring or if 
        pop do-shutdown exit
    then
    pop do-help
;