#!/usr/local/bin/tops -s /usr/local/tops/sys -u /opt/mytops/usr/
{
   File tops_wbsvr
   May 2008

   Copyright (C) 2008  Dale R. Williamson

   A web server to mimic Apache for simple requests.

   Running the program as a daemon, this script listens on port 9880 
   for an HTTP request on loopback forwarded to it by a server on the
   web like tops_http.

   This script sends back an HTTP response; if tops_http is the re-
   questor, it will send the response on to the original requestor.
}
\-----------------------------------------------------------------------

\  Words.

   CATMSG push no catmsg

   inline: adate (nsec --- qS) \ machine time into date 
{     Apache style date.

      Examples:

         [tops@plunger] ready > time adate .
         Wed, 21 May 2008 09:45:59 GMT 

         [tops@plunger] ready > "HOME" env "/.bashrc" + filetime adate .
         Mon, 19 May 2008 22:04:29 GMT 
}
      [ list: 1 3 2 6 4 5 ; ndx "R" book ]
      gmtime words R reach push
      peek 1st quote strchop "," + 
      peek 1st said pull vol2str
   end

   inline: aheader (qFile f --- hT) \ header from server for File
\     Apache style headers.
\     Incoming f is true for good request, false for bad request.
      [ "abcdef" "CHARS" book

        "123456789" "NUMS" book

        {"
           HTTP/1.1 __OK__
           Date: __DATE__
           Server: __SERVER__
           Last-Modified: __MOD__
           ETag: W/"__TAG__"
           Accept-Ranges: bytes
           Content-Length: __LEN__
           Keep-Alive: timeout=15, max=100
           Connection: Keep-Alive
           Content-Type: text/html; charset=iso-8859-1
        "} left justify "H1" book

        {"
           HTTP/1.1 __BAD__
           Date: __DATE__
           Server: __SERVER__
           Connection: close and block
           Content-Type: text/html; charset=iso-8859-1
        "} left justify "H2" book
      ] 

      IF "FILE" book
         H1 "__OK__" "200 OK" strp
         (hT) "__DATE__" time adate strp
         (hT) "__MOD__" FILE filetime adate strp
         (hT) "__LEN__" FILE filesize intstr strp
         (hT) "__TAG__" 
         NUMS 1 9 4 1 ranint ndx catch
         CHARS 1 6 1 1 ranint ndx catch + "-" +
 
         NUMS 1 9 2 1 ranint ndx catch +
         CHARS 1 6 1 1 ranint ndx catch + "-" +
 
         NUMS 1 9 6 1 ranint ndx catch +
         CHARS 1 6 2 1 ranint ndx catch + strp
      ELSE
         "FILE" book

       \ Use 200 here instead of 400 to fool IE into displaying:
         H2 "__BAD__" "200 Bad Request" strp
       \ H2 "__BAD__" "400 Bad Request" strp

         (hT) "__DATE__" time adate strp
      THEN
      (hT) " " pile
   end

   inline: WBSVR (hR nS --- ) \ send HTML response to R through socket S
      [ "/var/www/" "PATH" book \ where the files are 

        {" ( --- hT) \ Apache style HTML
           <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
           <HTML><HEAD>
           <TITLE>400 Bad Request</TITLE>
           </HEAD><BODY>
           <H1>Bad Request</H1>
           Your browser sent a request that this server will ignore.<P>
           The request line is unacceptable.<P>
           <P>
           <HR>
           <ADDRESS>__SERVER_AT__</ADDRESS>
           <P>
           __MSG__
           </BODY></HTML>
        "} left justify "BAD-TEXT" book

        {" ( --- hT)
           PATH "index.html" catpath "F" book
           F no aheader (hH) \ bad request

           BAD-TEXT (hT)

         \ Insert MSG:
           (hT) "__MSG__" tear (hTop hBot)

           PATH "/robots.txt" + asciiload (hMid)

           (hMid) notrailing 
           (hTop hBot hMid) swap 3 pilen (hT)
           "__MSG__" "" strp (hT) 
           
           (qH hT) pile (hT)
        "} "BAD-REQUEST" macro

        {" ( --- hT)
           PATH "index.html" catpath "F" book
           F no aheader (hH) \ bad request

           BAD-TEXT (hT)

         \ Insert MSG:
           (hT) "__MSG__" tear (hTop hBot)

           "tops -h > " scratch + minshell
           scratch asciiload scratch delete (hMid)

           (hMid) notrailing "<br>" tail
           (hTop hBot hMid) swap 3 pilen (hT)
           "__MSG__" "" strp (hT)

           (qH hT) pile (hT)
        "} "BAD-REQUEST1" macro
        
        "Apache/1.3.31-T (Debian GNU/Linux) PHP/4.3.4" "SVR" book

        "Apache/1.3.31-T Server at localhost Port 80" "SVR_AT" book
      ] 
      "S" book (hR) "R" book
      " WBSVR: on " host + " received from socket " +
      S intstr + ":" + . nl R . nl

      R 1st word 
      IF "GET" =
         IF R 2nd word 
            IF PATH swap catpath "F" book
               F file? 
               IF F -path "robots.txt" <>
                  IF F yes aheader 
                     F asciiload 
                     pile (hT)
                  ELSE BAD-REQUEST (hT)
                  THEN
               ELSE BAD-REQUEST (hT)
               THEN (hT)
            ELSE \ no 2nd word
               BAD-REQUEST (hT)
            THEN
         ELSE \ not GET method
           BAD-REQUEST (hT)
         THEN
      ELSE 
         BAD-REQUEST (hT)
      THEN
      (hT) "__SERVER__" SVR strp
      (hT) "__SERVER_AT__" SVR_AT strp

      (hT) textput (qT)
      (qT) NLch CRLF strp (qT) 
      (qT) S remoteputf
   end

   pull catmsg

\-----------------------------------------------------------------------

\  Define this as an HTTP server:
   "WBSVR" ptr "SERVE_F" "SERVICE" bank
   0 "SERVE_F" "TYPE" bank \ type HTTP

   30 (sec) new_client_timeout \ grace time

\  Restrict connections to loopback; local clients only:
   "127.0.0.1" "CLIENT_ALLOW" "clients" bank
   "127.0.0.1" "SERVER_ALLOW" "clients" bank

   9880 "PORT" book

   "*" PORT (qIPaddr nPort) keys? 
   IF 
    \ This portion runs during interactive debugging when this file
    \ is sourced at the ready prompt:
      (qIPaddr nPort) SERVER

   ELSE
    \ A log file is defined for SYSOUT using word set_sysout:
      "HOME" env "tops_wbsvr.log" catpath "LOG" book LOG set_sysout

    \ Display some starting lines in the log file:
      "-" 72 cats nl dot nl
      "PID " getpid int$ cat spaced date cat dot nl

      NIST_SYNC

      (qIPaddr nPort) DSERVER
   THEN

   private halt

\-----------------------------------------------------------------------

; Appendix

        {" ( --- qT) \ Apache style HTML
           <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
           <HTML><HEAD>
           <TITLE>400 Bad Request</TITLE>
           </HEAD><BODY>
           <H1>Bad Request</H1>
           Your browser sent a request that this server could not understand.<P>
           The request line contained invalid characters following the protocol string.<P>
           <P>
           <HR>
           <ADDRESS>Apache/1.3.31 Server at localhost Port 80</ADDRESS>
           </BODY></HTML>
        "} left justify textput "BAD-TEXT" book

        "Have a nice day" "GREET" book

        {" ( --- qT) 
           PATH "index.html" catpath "F" book
           F no aheader (hH) \ bad request

           R textget asciify dup "User-Agent:" grepr any?
           IF reach "User-Agent:" GREET strp 
           ELSE drop GREET
           THEN strchop NLch + (qR1)

           R vol2str (qR)
           1 over chars 6000 6500 1 1 ranint @ 1 ranint ndx
           (hR hChars) catch
           "  " NLch strp (qR2)

           (qR1 qR2) + wrapHTML (qT)

           (qH qT) + (qT)

        "} "BAD-REQUEST" macro

