Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#!/usr/local/bin/rebol -cs
Rebol [
Title: "HTTPD Scheme"
Date: 10-Jun-2013
Author: [
"Christopher Ross-Gill" 4-Jan-2017 "Adaptation to Scheme"
"Andreas Bolka" 4-Nov-2009 "A Tiny HTTP Server"
]
File: %httpd.reb
Version: <for-debugging>
Rights: http://opensource.org/licenses/Apache-2.0
Purpose: {
A Tiny Static Webserver Scheme for Rebol 3
Based on 'A Tiny HTTP Server' by Andreas Bolka
https://github.com/earl/rebol3/blob/master/scripts/shttpd.r
}
]
attempt [_: none] ; for Rebolsource Rebol 3 Compatibility
either not system/script/args [
call reform ["ren-c" system/options/script "--args foo bar"]
wait 1
loop 100 [
print join "RESPONSE: " read http://127.0.0.1.nip.io:8080/test
]
][
sys/make-scheme [
Title: "HTTP Server"
Name: 'httpd
Actor: [
Open: func [port [port!]][
port/locals: make object! [
subport: open [
scheme: 'tcp
port-id: port/spec/port-id
]
subport/awake: :port/scheme/awake-server
subport/locals: make object! [
parent: :port
body: _
]
]
port
]
Close: func [port [port!]][
close port/locals/subport
]
]
Status-Codes: make map! [
200 "OK" 400 "Forbidden" 404 "Not Found"
]
Respond: func [port response][
attempt [
write port ajoin ["HTTP/1.0 " response/status " " status-codes/(response/status) crlf]
write port ajoin ["Content-Type: " response/type crlf]
write port ajoin ["Content-Length: " length? response/content crlf]
write port crlf
;; Manual chunking is only necessary because of several bugs in R3's
;; networking stack (mainly cc#2098 & cc#2160; in some constellations also
;; cc#2103). Once those are fixed, we should directly use R3's internal
;; chunking instead: `write port body`.
]
port/locals/body: to binary! response/content
]
Send-Chunk: func [port [port!]][
;; Trying to send data >32'000 bytes at once will trigger R3's internal
;; chunking (which is buggy, see above). So we cannot use chunks >32'000
;; for our manual chunking.
either empty? port/locals/body [_][attempt [write port take/part port/locals/body 32'000]]
]
Awake-Client: use [from-actions chars][
from-actions: ["GET" | "POST"]
chars: complement union space: charset " " charset [#"^@" - #"^_"]
func [event [event!] /local port request response][
port: event/port
switch event/type [
read [
either find port/data to-binary rejoin [crlf crlf][
response: port/locals/parent/awake request: make object! [
action: target: _
parse to-string port/data [
copy action from-actions some space
copy target some chars some space
"HTTP/" ["1.0" | "1.1"]
]
]
respond port response
][
read port
]
]
wrote [unless send-chunk port [close port] port]
close [close port]
]
]
]
Awake-Server: func [event [event!] /local client] [
if event/type = 'accept [
client: first event/port
client/awake: :awake-client
read client
]
event
]
]
server: open [
Scheme: 'httpd
Port-ID: 8080
Awake: func [
request [object!]
][
make object! compose [
probe request/target
Status: 200
Type: "text/html"
Content: reword "<h1>OK! $action :: $target</h1>" compose [
action (request/action)
target (request/target)
]
]
]
]
wait [server]
close server
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.