Just in case anyone is intrested I just finished an update of my REBOL
webserver with support for rebol CGI scripts. The new version should be
more stable, now sets the content-length variable correctly, and can serve
up several files at once. It's not a great server yet, but it seems to work
well. If you have any comments/problems/suggestions I'd love to hear from
you...
(the server should be included as an attachment, if it didn't come through
it's "webserv.r" on rebol.org)
______________________________________________________
Get Your Private, Free Email at http://www.hotmail.com
REBOL [
Title: "REBOL Web Server"
File: %webserv.r
Author: "Cal Dixon"
Email: [EMAIL PROTECTED]
Date: 4-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 }
Version: 0.0.0.5
Category: 'web
]
secure none
system/options/quiet: true
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 tcp://:80
wwwpath: %./www/
queue: []
www-send: func [ conn data ] [ write-io conn data length? data ]
handle-cgi: func [ conn /local inport outport line headerfield contenttype
contentlength ] [
contenttype: none
contentlength: none
while [ ((line: first conn) <> "") and not none? line ] [
if found? headerfield: find/match line "Content-Type: " [
contenttype: head copy headerfield
]
if found? headerfield: find/match line "Content-Length: " [
contentlength: head copy headerfield
]
]
system/options/cgi: make cgi-obj compose [
server-software: "REBOL Web Server"
query-string: (urlquery)
request-method: (first request)
Content-Type: (contenttype)
Content-Length: (contentlength)
]
inport: system/ports/input
outport: system/ports/output
system/ports/input: conn
system/ports/output: conn
www-send conn "HTTP/1.0 200 OK^/"
if error? try [ catch [ do file-path ] ] []
system/ports/input: inport
system/ports/output: outport
close conn
]
content-type?: func [ filename [string! file!] ] [
ext: last parse to-string filename "."
switch/default ext [
"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 "^/^/" ]
]
handle-new-connections: func [ /local data conn ] [
if none? wait reduce [ listen 0 ] [ return ]
set [ file urlquery ] parse (pick (request: parse first (conn: first
listen) none) 2) "?"
if file = "/" [ file: "/index.html" ]
file-path: clean-path join wwwpath to-file next file
if not found? find file-path clean-path wwwpath [
file-path: clean-path join wwwpath "index.html"
]
either exists? file-path [
either none? content: content-type? file [
handle-cgi conn
] [
either dir? file-path [
send-header conn "404 Not Found" "text/html" length? e
www-send conn e
close conn
] [
send-header conn "200 OK" content length? (data: read/binary
file-path)
insert/only queue reduce [ conn data ]
]
]
] [
send-header conn "404 Not Found" "text/html" length? e
www-send conn e
close conn
]
]
forever [
if ( zero? ( length? queue ) ) [ wait listen ]
handle-new-connections
process-queue
]
