An HTTPD Scheme for Rebol 3 [Experimental]

httpd.reb

Rebol [
	Title: "HTTPD Scheme"
	Date: 27-Mar-2019
	Author: [
		"Oldes" 27-Mar-2019 "Rewritten Chris' HTTPD Scheme"
		"Christopher Ross-Gill" 4-Jan-2017 "Adaptation to Scheme"
		"Andreas Bolka" 4-Nov-2009 "A Tiny HTTP Server"
	]
	File: %httpd.r3
	Version: 0.3.0
	Rights: http://opensource.org/licenses/Apache-2.0
	Purpose: {
		A Tiny Webserver Scheme for Rebol 3 (Oldes' branch)
		Based on Christopher's experiment:
		https://gist.github.com/rgchris/73510e7d643eb0a6b9fa69b849cd9880
		Based on 'A Tiny HTTP Server' by Andreas Bolka
		https://github.com/earl/rebol3/blob/master/scripts/shttpd.r
	}
	Note: {
		The code is using system log calls available in Oldes' R3 version
		https://github.com/Oldes/Rebol3
	}
]

sys/make-scheme [
	Title: "HTTP Server"
	Name: 'httpd

	Actor: [
		Open: func [port [port!]][
			; probe port/spec
			;sys/log/info 'HTTPD ["Opening server at port:^[[22m" port/spec/port-id]
			port/locals: make object! [
				subport: open [
					scheme: 'tcp
					port-id: port/spec/port-id
				]
				subport/awake: :port/scheme/awake-server
			]
			port/awake: :awake-client

			port
		]

		Close: func [port [port!]][
			;sys/log/info 'HTTPD ["Closing server at port:^[[22m" port/spec/port-id]
			close port/locals/subport
		]

		On-Get: func[ctx [object!]][
			ctx/state: 'send-data
			ctx/out/status: 200
			;ctx/out/content: read %/x/snekoun1_2x.png
		]

		On-Post: func[ctx [object!]][
			;- POST action
			;TODO: handle `Expect` header: https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.20
			either ctx/inp/header/Content-Length > length? ctx/inp/content [
				ctx/state: 'read-data
			][
				ctx/state: 'data-received
				ctx/out/status: 200
				ctx/out/content: "OK"
			]
		]

		On-Read: func[
			"Process READ action on client's port"
			ctx [object!]
		][
			unless ctx/state [
				;sys/log/info 'HTTPD ["Request header:^[[22m" mold ctx/inp/header]
			]
			switch/default ctx/inp/action [
				"GET"  [ Actor/on-get  ctx ]
				"POST" [ Actor/on-post ctx ]
			][
				ctx/state: 'data-received
				ctx/out/status: 400 ; bad request
			]
		]
	]

	Status-Codes: make map! [
		200 "OK" 400 "Forbidden" 404 "Not Found"
	]

	Respond: func [port /local out][
		out: port/locals/out
		;sys/log/info 'HTTPD ["Respond:^[[22m" out/status status-codes/(out/status) length? out/content]
		; send the response header
		msg: ajoin ["HTTP/1.0 " out/status " " status-codes/(out/status) CRLF]
		if out/content [
			append msg ajoin [
				"Content-Type: " any [select out 'type "application/octet-stream"] CRLF
				"Content-Length: " length? out/content CRLF
			]
		]
		append msg CRLF
		write port msg
	]

	Awake-Client: wrap [
		from-actions: ["GET" | "POST"]
		chars: complement union space: charset " " charset [#"^@" - #"^_"]
		CRLF2BIN: #{0D0A0D0A}

		func [
			event [event!]
			/local ctx inp out port header-end
		][
			port: event/port
			ctx: port/locals
			inp: ctx/inp
			out: ctx/out

			;sys/log/more 'HTTPD ["Awake:^[[1m" ctx/remote "^[[22m" event/type]

			switch event/type [
				READ [
					;sys/log/more 'HTTPD ["bytes:^[[1m" length? port/data]
					either header-end: find/tail port/data CRLF2BIN [
						if none? ctx/state [
							with inp [
								parse copy/part port/data header-end [
									copy action from-actions some space
									copy target some chars some space
									"HTTP/" ["1.0" | "1.1"] thru CRLF
									copy header to end
									(
										action: to string! action
										target: to file!   target
										header: construct  header
										try [header/Content-Length: to integer! header/Content-Length]
									)
								]
								content: header-end
							]
						]
						actor/on-read port/locals

						;sys/log/debug 'HTTPD ["State:^[[1m" ctx/state "^[[22mstatus:^[[1m" out/status]

						either ctx/state = 'read-data [
							; posted data not fully read
							read port
						][	respond port ]
					][
						; request header not yet fully received
						read port
					]
				]
				WROTE [
					either all [
						out
						out/content
					][
						; for now just remove the content which is written
						; no need to chunk data manually, these are handled internaly
						; just make sure you don't use any other `write` before receiving `wrote`
						write port out/content
						port/locals/out/content: none
						;@@TODO:
						; content could be an opened port to file and we could stream it out
						; so big file would not be fully loaded into memory
					][
						; there is no other content to write, so close connection
						;sys/log/info 'HTTPD ["Closing:^[[22m" ctx/remote]
						close port
					]
					port
				]
				CLOSE [
					;sys/log/info "CLOSE EVENT -> IS THIS USED IN ANY SITUATION?"
					;sys/log/info 'HTTPD ["Closing:^[[22m" ctx/remote]
					close port
				]
			]
		]
	]

	Awake-Server: func [event [event!] /local client info] [
		;sys/log/debug 'HTTPD ["Awake (server):^[[22m" event/type]
		if event/type = 'accept [ New-Client event/port ]
		false
	]

	New-Client: func[port [port!] /local client info][
		client: first port
		client/awake: :Awake-Client
		info: query client
		client/locals: make object! [
			state: none
			parent: port
			remote: rejoin [tcp:// info/remote-ip #":" info/remote-port]
			inp: object [
				action:
				target:
				header:
				content: none
			]
			out: object [
				Status:
				Type: none
				Content: none
			]
		]
		;sys/log/info 'HTTPD ["New client:^[[1;31m" client/locals/remote]
		read client
	]
]

test-httpd.reb

Rebol [
	Title: "Test HTTPD Scheme"
	Date: 27-Mar-2019
	Author: ["Christopher Ross-Gill" "Oldes"]
	File: %test-httpd.r3
	Version: 0.2.0
	Rights: http://opensource.org/licenses/Apache-2.0
]

do %httpd.reb

server: open httpd://:8080
server/actor/on-get: func[
	ctx [object!]
][
	ctx/state: 'send-data
	ctx/out/status: 200
	ctx/out/type: "text/html"
	ctx/out/content: reword "<h1>OK!? $action :: $target</h1>" compose [
	    action (ctx/inp/action)
	    target (ctx/inp/target)
	]
]

attempt [browse http://127.0.0.1:8080/try/this/path]

wait server