Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

[REBOL] Extending Webserver.r Re:(3)

From: cybarite:sympatico:ca at: 13-Aug-2000 10:29

>>I do, that's why I'm biting the bullet and writing a web server. ;)
Eric, Writing the web server might be good experience. These notes might help (or not). ================================================================ I had a little bit of experience with this about a year ago after Carl released the webserver.r I wanted a rebol instance that would handle rebol scripts without having to launch a new instance of rebol ala CGI approach. This would give me faster response time in the mode that I was working in then which was the demonstration of some web prototypes. I wanted to be able to run a webserver, the web applications, and all of the html pages and graphics for a reasonable sized application prototype from a diskette. Hence REBOL. I made a few changes to the webserver.r code which I think they are all in the while block with comments to indicate the goal. For me, these changes made sense 'cause I was just trying to get the REBOL listener on port 80 to recognize that the URL pointed to a REBOL script - then knowing that, run it. So it this was fairly intuitive. ==================================================================== while [on] [ http-port: first wait listen-port request: first http-port file: "index.html" rebol: false ; turn this boolean off mime: "text/plain" parse request ["get" ["http" | "/ " | copy file to " "]] parse file [thru "." [ "htm" (mime: "text/html") | "html" (mime: "text/html") | "gif" (mime: "image/gif") | "jpg" (mime: "image/jpeg") | "r" (rebol: true ; being asked to process a REBOL script mime: "text/html") ; assuming that want to emit html from REBOL script ] ] if not none? (parts: parse file "?") ; Look for GET arguments [file: pick parts 1 ; plug the GET arguments back into the query-string ; so that the REBOL script will be able to get them system/options/cgi/query-string: pick parts 2] print ["retrieving:" file] any [ if not exists? web-dir/:file [send-error 404 file] either rebol ; if the url points in the get points to a rebol script, then just do it. [data: copy "" print: func [some_text] [append data some_text] if error? try [do web-dir/:file] [send-error 400 file] ] [if error? try [data: read/binary web-dir/:file] [send-error 400 file]] send-page data mime ] close http-port ] ============================================================================ ========= This did what I wanted and worked about an hour after I started it. The howevers : a. may not be what you want b. only handles low usage Cal Dixon ([deadzaphod--hotmail--com]) released a different version on the REBOL List a few days later. He updated it in January and February 2000. Cal's would: a. handle PUTs as well as GETs b. handle concurrent access but I did not run it since my few lines above met my needs. I just checked the REBOL script site and could not find it. The source that Cal produced was: ============================================================================ ============ REBOL [ Title: "REBOL Web Server" File: %webserv.r Author: "Cal Dixon" Email: [deadzaphod--hotmail--com] Date: 26-Feb-2000 Purpose: { A Simple HTTP-Server that can run REBOL CGI scripts } Notes: { 0.0.0.3: This version redirects all i/o to the web browser so 'read-io on system/ports/input can be used to get POSTed data, etc.. 0.0.0.4: Now has better error checking and passes content-length as a string like it should 0.0.0.5: Can now send multiple files at once 0.0.0.6: Now patches 'print and 'prin to work correctly and passes all http headers to CGIs also translates access to a folder to %index.html in that folder. Also handles the HTTP HEAD method in addition to GET and sends the Last-Modified header 0.0.0.7: Added logging in Extended Common Log Format - but for CGI scripts the number of bytes sent is recorded as 1, due to current limitations of this program } Version: 0.0.0.7 Category: 'web ] wwwpath: %www/ ; change this to where the files are... port: 80 ; change this to whatever port the server should listen to logfile: %webserv.log ; the name of the logfile or set to none secure none system/options/quiet: false e: {<HTML><HEAD><TITLE>404 Not Found</TITLE></HEAD><BODY>Page not found.</BODY></HTML>} cgi-obj: make system/options/cgi [ context: func [] [ return 'context ] ] listen: open/lines/direct join tcp://: port inport: system/ports/input outport: system/ports/output queue: [] ; these replacements for 'print and 'prin should work better for CGI scripts prin: func [ out /local data ] [ data: replace/all (reform out) newline "^M^J" write-io system/ports/output data length? data return ] print: func [ out /local data ] [ data: replace/all (reform out) newline "^M^J" data: append data "^M^J" write-io system/ports/output data length? data return ] quit: halt: func [] [throw] www-send: func [ conn data ] [ write-io conn data length? data ] either logfile [ write-log: func [ entry ] [ write/append logfile join to-string entry newline ] ][ write-log: func [ ignorethisvalue ] [] ] get-http-headers: func [ conn /local line buffer a b c ] [ buffer: copy [] while [ ((line: first conn) <> "") and not none? line ] [ a: copy/part line b: find line ":" c: trim next b insert buffer reduce [ a c ] ] return buffer ] handle-cgi: func [ conn request query headers /local cd ] [ system/options/cgi: make cgi-obj compose [ server-software: "REBOL Web Server" server-name: (read dns://) gateway-interface: "CGI/1.1" server-protocol: "HTTP/1.0" server-port: "80" query-string: (query) request-method: (pick request 1) script-name: (first parse (pick request 2) "?") Content-Type: (select headers "Content-Type") Content-Length: (select headers "Content-Length") other-headers: (headers) ] cd: what-dir system/ports/output: conn system/ports/input: conn www-send conn "HTTP/1.0 200 OK^/" if error? try [ catch [ do file-path ] ] [] system/ports/input: inport system/ports/output: outport change-dir cd close conn ] content-type?: func [ filename [string! file!] ] [ switch/default next find/last to-string filename "." [ "txt" [ return "text/plain" ] "gif" [ return "image/gif" ] "jpg" [ return "image/jpeg" ] "png" [ return "image/png" ] "mov" [ return "video/quicktime" ] "tif" [ return "image/tiff" ] "tiff" [ return "image/tiff" ] "wav" [ return "audio/wav" ] "xml" [ return "text/xml" ] "xsl" [ return "text/xml" ] "mid" [ return "audio/midi" ] "r" [ return none ] ] [ return "text/html" ] ] process-queue: func [ /local connection data file conn newqueue ] [ newqueue: copy [] foreach connection queue [ set [ conn file ] connection data: copy/part file 2048 file: skip file 2048 write-io conn data length? data either tail? file [ close conn ] [ insert/only newqueue reduce [ conn file ] ] ] queue: newqueue ] send-header: func [ conn result content-type data-length ] [ www-send conn rejoin [ "HTTP/1.0 " result newline "Content-Type: " content-type newline "Content-Length: " data-length newline "Date: " to-idate now newline "Last-Modified: " to-idate modified? file-path "^/^/" ] ] translate-request-to-resource: func [ file /local file-path ] [ if (last file) = #"/" [ append file "index.html" ] file-path: clean-path join wwwpath to-file next file if none? find file-path clean-path wwwpath [ file-path: clean-path join wwwpath "index.html" ] if dir? file-path [ append file-path "/index.html" ] return file-path ] http-log: func [ host request status bytes /extended headers /local when agent referer] [ when: rejoin [ replace/all copy/part mold now 11 "-" "/" replace skip mold now 11 "/" ":" ] replace when "-" " -" either (agent: select headers "User-Agent") [ agent: join {"} [ agent {"} ] ][ agent: "-" ] either (referer: select headers "Referer") [ referer: join {"} [ referer {"} ] ][ referer: "-" ] reform [ host "- -" rejoin [ "[" when "]" ] mold form request status bytes either extended [ reform [ referer agent ] ][ "" ] ] ] handle-new-connections: func [ /local data conn http-headers ] [ if none? wait reduce [ listen 0 ] [ return ] request: parse first (conn: first listen) none if (length? queue) > 3000 [ insert conn "HTTP/1.0 503 Server Overloaded^/" close conn return ] ; refuse connections if server is overloaded request-method: pick request 1 set [ file urlquery ] parse (pick request 2) "?" file-path: translate-request-to-resource file http-headers: get-http-headers conn either exists? file-path [ either none? content: content-type? file-path [ write-log http-log/extended conn/host request 200 1 http-headers handle-cgi conn request urlquery http-headers return ] [ write-log http-log/extended conn/host request 200 size? file-path http-headers set [ responce data ] reduce [ "200 OK" (data: read/binary file-path) ] ] ] [ write-log http-log/extended conn/host request 404 0 http-headers set [ responce content data file-path ] reduce [ "404 Not Found" text/html e %. ] ] send-header conn responce content length? data if request-method = "HEAD" [ close conn return ] insert/only queue reduce [ conn data ] ] forever [ if ( zero? ( length? queue ) ) [ wait listen ] handle-new-connections process-queue ]