Last active
August 3, 2016 18:21
-
-
Save rgchris/298424c071710b5cb1d3e922c1ed7987 to your computer and use it in GitHub Desktop.
Rebol (Ren/C) HTTPD Server Scheme
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/local/bin/ren-c | |
Rebol [ | |
Title: "A tiny static HTTP server" | |
Author: ["abolka" "Giulio Lunati"] | |
Date: [2009-11-04 2016-07-25] | |
; name: shttpd | |
; type: module | |
; exports: [shttpd] | |
] | |
sys/make-scheme [ | |
title: "Static HTTP Server" | |
name: 'httpd | |
locals: make object! [ | |
subport: none | |
code-map: make map! [200 "OK" 400 "Forbidden" 404 "Not Found"] | |
mime-map: make map! [ | |
"html" "text/html" "css" "text/css" "js" "application/javascript" | |
"gif" "image/gif" "jpg" "image/jpeg" "png" "image/png" | |
"r" "text/plain" "r3" "text/plain" "reb" "text/plain" | |
] | |
error-template: trim/auto { | |
<html><head><title>$code $text</title></head><body><h1>$text</h1> | |
<p>Requested URI: <code>$uri</code></p><hr><i>shttpd.r</i> on | |
<a href="http://www.rebol.com/rebol3/">REBOL 3</a> $r3</body></html> | |
} | |
error-response: func [code uri /local values] [ | |
values: [code (code) text (code-map/:code) uri (uri) r3 (system/version)] | |
reduce [code "text/html" reword error-template compose values] | |
] | |
start-response: func [port res /local code text type body] [ | |
set [code type body] res | |
write port ajoin ["HTTP/1.0 " code " " code-map/:code crlf] | |
write port ajoin ["Content-type: " type crlf] | |
write port ajoin ["Content-length: " length? body crlf] | |
write port crlf | |
write port body | |
] | |
handle-request: func [config req /local uri path type file data ext] [ | |
parse to-string req ["get " ["/ " | copy uri to " "]] | |
uri: default "index.html" | |
print ["URI:" uri] | |
parse uri [ copy path [to #"?" | to end]] | |
parse path [some [thru "."] copy ext to end (type: mime-map/:ext)] | |
type: default "application/octet-stream" | |
if not exists? file: config/root/:path [return error-response 404 uri] | |
if error? try [data: read file] [return error-response 400 uri] | |
reduce [200 type data] | |
] | |
awake-client: func [event /local port res] [ | |
port: event/port | |
switch event/type [ | |
read [ | |
either find port/data to-binary join crlf crlf [ | |
res: handle-request port/locals/config port/data | |
start-response port res | |
] [ | |
read port | |
] | |
] | |
wrote [wait port close port] | |
close [close port] | |
] | |
] | |
awake-server: func [event /local client] [ | |
if event/type = 'accept [ | |
client: first event/port | |
client/awake: :awake-client | |
read client | |
] | |
] | |
serve: func [web-port web-root /local listen-port] [ | |
listen-port: open join tcp://: web-port | |
listen-port/locals: has compose/deep [config: [root: (web-root)]] | |
listen-port/awake: :awake-server | |
wait listen-port | |
] | |
] | |
actor: [ | |
open: func [port [port!]][ | |
port/locals: make port/scheme/locals [ | |
listen-port: open join tcp://: port/spec/port-id | |
listen-port/locals: probe make object! [config: reduce ['root what-dir]] | |
listen-port/awake: function [event][port/awake event] | |
] | |
port/awake: get in port/locals 'awake-server | |
port | |
] | |
] | |
awake: none | |
] | |
change-dir %/path/containing/index.html/ | |
httpd: open httpd://:8080 | |
wait [httpd] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment